autodns.pl

   1 #!/usr/bin/perl -Tw
   2 # autodns 1.0.0
   3 # Copyright 1999-2006 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.
   7 #
   8
   9 use strict;
  10 use Date::Parse;
  11 use Fcntl qw(:flock);
  12 use File::Path;
  13 use File::Temp qw(tempfile);
  14 use IPC::Open3;
  15 use MIME::Parser;
  16
  17 $ENV{'PATH'} = "/usr/local/bin:/usr/bin:/bin:/usr/sbin";
  18
  19 my ($from, $subject, $gpguser, $gpggood, $priv);
  20 my ($user, $server, $inprocess, $delcount, $addcount);
  21 my ($domain, @MAIL, @GPGERROR, @COMMANDS, %zones, $VERSION);
  22
  23 use vars qw($me $ccreply $conffile $domainlistroot @cfgfiles $usersfile
  24         $lockfile $reload_command $expiry $zonefiledir);
  25
  26 $VERSION = "1.0.0";
  27
  28 #
  29 # Load our config
  30 #
  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";
  37 }
  38
  39 ###
  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.
  42 ###
  43
  44 #
  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.
  47 #
  48 # Call with the name of a config file to read:
  49 #
  50 # getzones("/etc/named.conf");
  51 #
  52 sub getzones($) {
  53         my $namedfile = shift;
  54
  55         open (NAMEDCONF, "< $namedfile") or
  56                 fatalerror("Can't open $namedfile");
  57
  58         while (<NAMEDCONF>) {
  59                 if (/^\s*zone\s*"([^"]+)"/) {
  60                         $zones{$1}=1;
  61                 }
  62         }
  63
  64         close NAMEDCONF;
  65 }
  66
  67 #
  68 # Check that a domain is only made up of valid characters.
  69 #
  70 # These are: a-z, 0-9, - or .
  71 #
  72 sub valid_domain($) {
  73         my $domain = shift;
  74         $domain = lc $domain;
  75
  76         if ($domain =~ /^(?:[a-z0-9-]+\.)+[a-z]{2,6}$/) {
  77                 return 1;
  78         } elsif ($domain =~ /^(?:[0-9\/-]+\.)+in-addr.arpa$/) {
  79                 return 1;
  80         } else {
  81                 return 0;
  82         }
  83 }
  84
  85 #
  86 # Deal with a fatal error by printing an error message, closing the pipe to
  87 # sendmail and exiting.
  88 #
  89 # fatalerror("I'm melting!");
  90 #
  91 sub fatalerror($) {
  92         my $message = shift;
  93
  94         print REPLY $message;
  95         close(REPLY);
  96
  97         flock(LOCKFILE, LOCK_UN);
  98         close(LOCKFILE);
  99         unlink($lockfile);
 100
 101         exit;
 102 }
 103
 104 #
 105 # Get user details from usersfile based on a PGP ID.
 106 #
 107 # A users entry looks like:
 108 #
 109 # <username>:<keyid>:<privilege level>:<master server ip>
 110 #
 111 # Priviledge level is not currently used.
 112 #
 113 # ($user, $priv, $server) = getuserinfo("5B430367");
 114 #
 115 sub getuserinfo($) {
 116         my $gpguser = shift;
 117         my ($user, $privilege, $server);
 118
 119         open (CONFIGFILE, "< $usersfile") or
 120                 fatalerror("Couldn't open user configuration file.");
 121
 122         foreach (<CONFIGFILE>) {
 123                 if (/^([^#.]+):$gpguser:(\d+):(.+)$/) {
 124                         $user = $1;
 125                         $privilege = $2;
 126                         $server = $3;
 127                         chomp $user;
 128                         chomp $privilege;
 129                         chomp $server;
 130
 131                         if ($user !~ /^.+$/) {
 132                                 close(CONFIGFILE);
 133                                 fatalerror("Error in user configuration ".
 134                                                 "file: Can't get username.\n");
 135                         }
 136
 137                         if ($server !~ /^(\d{1,3}\.){3}\d{1,3}$/) {
 138                                 $server =~ s/\d\.]//g;
 139                                 close(CONFIGFILE);
 140                                 fatalerror("Error in user configuration ".
 141                                         "file: Invalid primary server IP ".
 142                                         "address ($server)\n");
 143                                 exit;
 144                         }
 145                 }
 146         }
 147         close(CONFIGFILE);
 148
 149         if ($user =~ /^$/) {
 150                 fatalerror("User not found.\n");
 151         }
 152
 153         return ($user, $privilege, $server);
 154 }
 155
 156 #
 157 # Add a new AutoDNS user.
 158 #
 159 # addautodnsuser($username, $keyid, $priv, $masterip);
 160 # <username>:<keyid>:<privilege level>:<master server ip>
 161 #
 162 sub addautodnsuser($$$$) {
 163         my $username = shift;
 164         my $keyid = shift;
 165         my $priv = shift;
 166         my $masterip = shift;
 167
 168         # Create domains file for the user.
 169         open (DOMAINLIST, ">>$domainlistroot$username") or
 170                         fatalerror("Couldn't create domains file.\n");
 171         close DOMAINLIST;
 172
 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;
 177
 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";
 182         close(USERFILE);
 183 }
 184
 185 $delcount = $addcount = $inprocess = 0;
 186
 187 # Read in the mail from stdin.
 188 @MAIL = <>;
 189
 190 $subject = "Reply from AutoDNS";
 191 # Now lets try to find out who it's from.
 192 foreach (@MAIL) {
 193         if (/^$/) { last; }
 194         if (/^From: (.*)/i) { $from = $1; chomp $from;}
 195         if (/^Subject:\s+(re:)?(.*)$/i) { $subject = "Re: ".$2 if ($2);}
 196 }
 197
 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.";
 202 }
 203
 204 if (! defined($subject)) { $subject = "Reply from AutoDNS"; };
 205
 206 # We've got a from address. Start a reply.
 207
 208 open(REPLY, "|sendmail -t -oem -oi") or die "Couldn't spawn sendmail";
 209
 210 print REPLY "From: $me\n";
 211 print REPLY "To: $from\n";
 212 #
 213 # Check to see if our CC address is the same as the from address and if so
 214 # don't CC.
 215 #
 216 if ($from ne $ccreply) {
 217         print REPLY "Cc: $ccreply\n";
 218 }
 219 print REPLY <<EOF;
 220 Subject: $subject
 221
 222 AutoDNS $VERSION
 223 Copyright 1999-2006 Project Purple. Written by Jonathan McDowell.
 224 Released under the GPL.
 225
 226 EOF
 227
 228 #
 229 # Throw the mail at MIME::Parser and see if it accepts it.
 230 #
 231 my $parser = new MIME::Parser;
 232 $parser->output_to_core(1); # No temporary files
 233 my $entity = $parser->parse_data(\@MAIL);
 234
 235 #
 236 # Make sure locale is set to C so we get messages in English as we expect.
 237 #
 238 $ENV{'LC_ALL'} = "C";
 239
 240 if ($entity->parts) {
 241         # MIME
 242
 243         my ($got_sig, $got_text) = (0, 0);
 244         my ($sig_fh, $sig_name) = tempfile();
 245         my ($text_fh, $text_name) = tempfile();
 246
 247         foreach my $subent ($entity->parts) {
 248                 if ($subent->effective_type eq "text/plain") {
 249                         @COMMANDS = split /\n/,$subent->bodyhandle->as_string;
 250
 251                         my $str = $subent->as_string;
 252                         $str =~ s/=\n$//;
 253                         $str =~ s/\n/\r\n/g;
 254                         print $text_fh $str;
 255                         close($text_fh);
 256                         $got_text++;
 257                 } elsif ($subent->effective_type eq
 258                                 "application/pgp-signature") {
 259                         print $sig_fh $subent->as_string;
 260                         close($sig_fh);
 261                         $got_sig++;
 262                 } elsif ($subent->effective_type eq "multipart/mixed") {
 263                         my $str = $subent->as_string;
 264                         print $text_fh $str;
 265                         close($text_fh);
 266                         $got_text++;
 267
 268                         foreach my $mixent ($subent->parts) {
 269                                 if ($mixent->effective_type eq "text/plain") {
 270                                         push @COMMANDS, (split /\n/,
 271                                                 $mixent->bodyhandle->as_string);
 272                                 }
 273                                 if ($mixent->effective_type eq
 274                                                 "application/pgp-keys") {
 275                                         push @COMMANDS, (split /\n/,
 276                                                 $mixent->bodyhandle->as_string);
 277                                 }
 278                         }
 279                 }
 280         }
 281
 282         if ($got_sig && $got_text) {
 283                 my $pid = open3(\*GPGIN, \*GPGOUT, \*GPGERR,
 284                         "gpg --batch --verify ".
 285                         $sig_name." ".$text_name);
 286
 287                 close GPGIN;
 288
 289                 @GPGERROR = <GPGERR>;
 290                 my @GPGOUTPUT = <GPGOUT>;
 291                 close GPGERR;
 292                 close GPGOUT;
 293                 waitpid $pid, 0;
 294
 295                 unlink($text_name);
 296                 unlink($sig_name);
 297         }
 298 } else {
 299         # Clear text.
 300
 301         my $pid = open3(\*GPGIN, \*GPGOUT, \*GPGERR, "gpg --batch --verify");
 302
 303         # Feed it the mail.
 304         print GPGIN $entity->bodyhandle->as_string;
 305         close GPGIN;
 306
 307         # And grab what it has to say.
 308         @GPGERROR = <GPGERR>;
 309         @COMMANDS = <GPGOUT>;
 310         @COMMANDS = split /\n/,$entity->bodyhandle->as_string;
 311         close GPGERR;
 312         close GPGOUT;
 313         waitpid $pid, 0;
 314 }
 315
 316 # Check who it's from and if the signature was a good one.
 317 $gpggood=1;
 318 my $sigtime = 0;
 319 foreach (@GPGERROR) {
 320         chomp;
 321         if (/Signature made (.*) using.*ID (.*)$/) {
 322                 $sigtime = str2time($1);
 323                 $gpguser = $2;
 324         } elsif (/error/) {
 325                 $gpggood = 0;
 326                 print REPLY "Some errors ocurred\n";
 327         } elsif (/BAD signature/) {
 328                 $gpggood = 0;
 329                 print REPLY "BAD signature!\n";
 330         } elsif (/public key not found/) {
 331                 $gpggood = 0;
 332                 print REPLY "Public Key not found\n";
 333         }
 334 }
 335
 336 # If we have an empty user it probably wasn't signed.
 337 if (! $gpguser) {
 338         print REPLY "Message appears not to be GPG signed.\n";
 339         close REPLY;
 340         exit;
 341 }
 342
 343 # Check the signature we got was ok.
 344 if ($gpggood) {
 345         print REPLY "Good GPG signature found. ($gpguser)\n";
 346 } else {
 347         print REPLY "Bad GPG signature!\n";
 348         close REPLY;
 349         exit;
 350 }
 351
 352 # Check if the signature is outside our acceptable range.
 353 if (!defined($sigtime)) {
 354         print REPLY "Couldn't parse signature time.\n";
 355         close REPLY;
 356         exit;
 357 } elsif ($sigtime > (time + $expiry)) {
 358         print REPLY "Signature too far into the future.\n";
 359         close REPLY;
 360         exit;
 361 } elsif ($sigtime < (time - $expiry)) {
 362         print REPLY "Signature too far into the past.\n";
 363         close REPLY;
 364         exit;
 365 }
 366
 367 # Now let's check if we know this person.
 368 ($user, $priv, $server) = getuserinfo($gpguser);
 369
 370 if (! defined($user) || ! $user) {
 371         print REPLY "Unknown user.\n";
 372         close REPLY;
 373         exit;
 374 }
 375
 376 print REPLY "Got user '$user'\n";
 377
 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));
 383
 384 # Ok, now we should figure out what domains we already know about.
 385 foreach my $cfgfile (@cfgfiles) {
 386         getzones($cfgfile);
 387 }
 388
 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");
 393         close DOMAINLIST;
 394 }
 395
 396 foreach (@COMMANDS) {
 397         # Remove trailing CRs and leading/trailing whitespace
 398         chomp;
 399         s/\r//;
 400         s/^\s*//;
 401         s/\s*$//;
 402
 403         if ($inprocess) {
 404                 print REPLY ">>>$_\n";
 405         }
 406
 407         if (/^$/) {
 408                 #
 409                 # Empty line, so ignore it.
 410                 #
 411         } elsif (/^END$/) {
 412                 $inprocess = 0;
 413         } elsif (/^BEGIN$/) {
 414                 $inprocess = 1;
 415         } elsif ($inprocess && /^ADD\s+(.*)$/) {
 416                 $domain = $1;
 417
 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:",
 423                                         " $domain\n";
 424                 } elsif (defined($zones{$domain}) && $zones{$domain}) {
 425                         print REPLY "We already secondary $domain\n";
 426                 } else {
 427                         print REPLY "Adding domain $domain\n";
 428                         $zones{$domain} = 1;
 429
 430                         my $df = $domain;
 431                         $df =~ tr,/,:,;
 432
 433                         open (DOMAINSFILE, ">>$conffile");
 434                         print DOMAINSFILE "
 435 ### Domain added for '$user'
 436
 437 zone \"$domain\" {
 438         type slave;
 439         masters { $server; };
 440         file \"secondary/$user/$df\";
 441         allow-transfer { none; };
 442         allow-query { any; };
 443 };\n";
 444                         close DOMAINSFILE;
 445
 446                         open (DOMAINLIST, ">>$domainlistroot$user") or
 447                                 fatalerror("Couldn't open file.\n");
 448                         print DOMAINLIST "$domain\n";
 449                         close DOMAINLIST;
 450                         $addcount++;
 451                 }
 452         } elsif ($inprocess && /^DEL\s(.*)$/) {
 453                 $domain = $1;
 454
 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:",
 460                                         " $domain\n";
 461                 } elsif (!defined($zones{$domain}) || !$zones{$domain}) {
 462                                 print REPLY "$domain does not exist!\n";
 463                 } else {
 464                         print REPLY "Deleting domain $domain\n";
 465                         my (@newcfg, $found);
 466
 467                         open (DOMAINLIST, "<$domainlistroot$user") or
 468                                 fatalerror("Couldn't open file ".
 469                                                 $domainlistroot.$user.
 470                                                 " for reading: $!.\n");
 471                         my @cfg = <DOMAINLIST>;
 472                         close(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";
 479                                 next;
 480                         }
 481
 482                         open (DOMAINLIST, ">$domainlistroot$user") or
 483                                 fatalerror("Couldn't open file ".
 484                                                 $domainlistroot.$user.
 485                                                 " for writing: $!.\n");
 486                         print DOMAINLIST @newcfg;
 487                         close DOMAINLIST;
 488
 489                         $found = 0;
 490                         @newcfg = ();
 491                         open (DOMAINSFILE, "<$conffile") or
 492                                 fatalerror("Couldn't open file $conffile for".
 493                                                 " reading: $!\n");
 494                         {
 495                         local $/ = ''; # eat whole paragraphs
 496                         while (<DOMAINSFILE>) {
 497                                 unless (/^\s*zone\s+"$domain"/) {
 498                                         push @newcfg, $_;
 499                                 } else {
 500                                         $found = 1;
 501                                         if ($newcfg[-1] =~ /^###/) {
 502                                                 # remove comment and \n
 503                                                 pop @newcfg;
 504                                         }
 505                                 }
 506                         }
 507                         } # end of paragraph eating
 508
 509                         if (!$found) {
 510                                 print REPLY "Didn't find $domain in",
 511                                                 " $conffile!\n";
 512                                 next;
 513                         }
 514
 515                         open (DOMAINSFILE, ">$conffile") or
 516                                 fatalerror("Couldn't open $conffile for".
 517                                                 " writing: $!\n");
 518                         print DOMAINSFILE @newcfg;
 519                         close DOMAINSFILE;
 520                         $delcount++;
 521                         $zones{$domain} = 0;
 522                 }
 523         } elsif ($inprocess && /^LIST$/) {
 524                 print REPLY "Listing domains for user $user\n";
 525                 print REPLY "------\n";
 526                 if (open (DOMAINLIST, "<$domainlistroot$user")) {
 527                         my $count = 0;
 528                         while (<DOMAINLIST>) {
 529                                 $count++;
 530                                 print REPLY;
 531                         }
 532                         close (DOMAINLIST);
 533                         print REPLY "------\n";
 534                         print REPLY "Total of $count domains.\n";
 535                 } else {
 536                         print REPLY "Couldn't open $domainlistroot$user: $!\n";
 537                 }
 538         } elsif ($inprocess && /^MASTER\s(.*)$/) {
 539                 if (($priv & 1) != 1) {
 540                         print REPLY "You're not authorised to use the MASTER ",
 541                                 "command.\n";
 542                 } elsif ($1 =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/) {
 543                         $server = $1;
 544                         print REPLY "Set master IP address to $1\n";
 545                 } else {
 546                         print REPLY "$1 doesn't look like a valid IPv4 ",
 547                                 "address to me.\n";
 548                 }
 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);
 555
 556                         print REPLY "Attempting to import new key:\n";
 557
 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");
 562
 563                         # Feed it the mail.
 564                         print GPGIN join("\n", @COMMANDS);
 565                         close GPGIN;
 566
 567                         # And grab what it has to say.
 568                         @GPGERROR = <GPGERR>;
 569                         my @GPGOUTPUT = <GPGOUT>;
 570                         close GPGERR;
 571                         close GPGOUT;
 572                         waitpid $pid, 0;
 573
 574                         print REPLY @GPGERROR;
 575                 } else {
 576                         print REPLY "ADDUSER parameter error.\n";
 577                 }
 578         } elsif ($inprocess && /^HELP$/) {
 579                 print REPLY <<EOF;
 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).
 584
 585 Current valid commands are:
 586
 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.
 593 EOF
 594                 if (($priv & 1) == 1) {
 595                         print REPLY "MASTER <ip address> - set the nameserver".
 596                         " we should slave off for subsequent ADD\ncommands.\n";
 597                 }
 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";
 602                 }
 603         } elsif ($inprocess) {
 604                 print REPLY "Unknown command!\n";
 605         }
 606 }
 607 flock(LOCKFILE, LOCK_UN);
 608 close(LOCKFILE);
 609 unlink($lockfile);
 610
 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`;
 616 }
 617 close REPLY;
 618
 619 exit 0;