autodns.pl

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