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 #       die $message;
 104         exit;
 105 }
 106
 107 #
 108 # Get user details from usersfile based on a PGP ID.
 109 #
 110 # A users entry looks like:
 111 #
 112 # <username>:<keyid>:<privilege level>:<master server ip>
 113 #
 114 # Priviledge level is not currently used.
 115 #
 116 # ($user, $priv, $server) = getuserinfo("5B430367");
 117 #
 118 sub getuserinfo($) {
 119         my $gpguser = shift;
 120         my ($user, $privilege, $server);
 121
 122         open (CONFIGFILE, "< $usersfile") or
 123                 fatalerror("Couldn't open user configuration file.");
 124
 125         foreach (<CONFIGFILE>) {
 126                 if (/^([^#.]+):$gpguser:(\d+):(.+)$/) {
 127                         $user=$1;
 128                         $privilege=$2;
 129                         $server=$3;
 130                         chomp $user;
 131                         chomp $privilege;
 132                         chomp $server;
 133
 134                         if ($user !~ /^.+$/) {
 135                                 close(CONFIGFILE);
 136                                 fatalerror("Error in user configuration 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 file: Invalid primary server IP 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-2004 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_name,$sig_fh,$text_name,$text_fh);
 245         ($sig_fh, $sig_name) = tempfile();
 246         ($text_fh, $text_name) = tempfile();
 247
 248         foreach my $subent ($entity->parts) {
 249                 if ($subent->effective_type eq "text/plain") {
 250                         @COMMANDS = split /\n/,$subent->bodyhandle->as_string;
 251
 252                         my $str = $subent->as_string;
 253                         $str =~ s/=\n$//;
 254                         $str =~ s/\n/\r\n/g;
 255                         print $text_fh $str;
 256                         close($text_fh);
 257                         $got_text++;
 258                 } elsif ($subent->effective_type eq
 259                                 "application/pgp-signature") {
 260                         print $sig_fh $subent->as_string;
 261                         close($sig_fh);
 262                         $got_sig++;
 263                 } elsif ($subent->effective_type eq "multipart/mixed") {
 264                         my $str = $subent->as_string;
 265                         print $text_fh $str;
 266                         close($text_fh);
 267                         $got_text++;
 268
 269                         foreach my $mixent ($subent->parts) {
 270                                 if ($mixent->effective_type eq "text/plain") {
 271                                         push @COMMANDS, (split /\n/,
 272                                                 $mixent->bodyhandle->as_string);
 273                                 }
 274                                 if ($mixent->effective_type eq
 275                                                 "application/pgp-keys") {
 276                                         push @COMMANDS, (split /\n/,
 277                                                 $mixent->bodyhandle->as_string);
 278                                 }
 279                         }
 280                 }
 281         }
 282
 283         if ($got_sig && $got_text) {
 284                 my $pid = open3(\*GPGIN, \*GPGOUT, \*GPGERR,
 285                         "gpg --batch --verify ".
 286                         $sig_name." ".$text_name);
 287
 288                 close GPGIN;
 289
 290                 @GPGERROR=<GPGERR>;
 291                 my @GPGOUTPUT=<GPGOUT>;
 292                 close GPGERR;
 293                 close GPGOUT;
 294                 waitpid $pid, 0;
 295
 296                 unlink($text_name);
 297                 unlink($sig_name);
 298         }
 299 } else {
 300         # Clear text.
 301
 302         my $pid = open3(\*GPGIN, \*GPGOUT, \*GPGERR, "gpg --batch --verify");
 303
 304         # Feed it the mail.
 305         print GPGIN $entity->bodyhandle->as_string;
 306         close GPGIN;
 307
 308         # And grab what it has to say.
 309         @GPGERROR=<GPGERR>;
 310         @COMMANDS=<GPGOUT>;
 311         @COMMANDS = split /\n/,$entity->bodyhandle->as_string;
 312         close GPGERR;
 313         close GPGOUT;
 314         waitpid $pid, 0;
 315 }
 316
 317 # Check who it's from and if the signature was a good one.
 318 $gpggood=1;
 319 my $sigtime = 0;
 320 foreach (@GPGERROR) {
 321         chomp;
 322         if (/Signature made (.*) using.*ID (.*)$/) {
 323                 $sigtime = str2time($1);
 324                 $gpguser=$2;
 325         } elsif (/error/) {
 326                 $gpggood = 0;
 327                 print REPLY "Some errors ocurred\n";
 328         } elsif (/BAD signature/) {
 329                 $gpggood = 0;
 330                 print REPLY "BAD signature!\n";
 331         } elsif (/public key not found/) {
 332                 $gpggood = 0;
 333                 print REPLY "Public Key not found\n";
 334         }
 335 }
 336
 337 # If we have an empty user it probably wasn't signed.
 338 if (! $gpguser) {
 339         print REPLY "Message appears not to be GPG signed.\n";
 340         close REPLY;
 341         exit;
 342 }
 343
 344 # Check the signature we got was ok.
 345 if ($gpggood) {
 346         print REPLY "Good GPG signature found. ($gpguser)\n";
 347 } else {
 348         print REPLY "Bad GPG signature!\n";
 349         close REPLY;
 350         exit;
 351 }
 352
 353 # Check if the signature is outside our acceptable range.
 354 if (!defined($sigtime)) {
 355         print REPLY "Couldn't parse signature time.\n";
 356         close REPLY;
 357         exit;
 358 } elsif ($sigtime > (time + $expiry)) {
 359         print REPLY "Signature too far into the future.\n";
 360         close REPLY;
 361         exit;
 362 } elsif ($sigtime < (time - $expiry)) {
 363         print REPLY "Signature too far into the past.\n";
 364         close REPLY;
 365         exit;
 366 }
 367
 368 # Now let's check if we know this person.
 369 ($user, $priv, $server) = getuserinfo($gpguser);
 370
 371 if (! defined($user) || ! $user) {
 372         print REPLY "Unknown user.\n";
 373         close REPLY;
 374         exit;
 375 }
 376
 377 print REPLY "Got user '$user'\n";
 378
 379 # Right. We know this is a valid user. Get a lock to ensure we have exclusive
 380 # access to the configs from here on in.
 381 open (LOCKFILE,">$lockfile") ||
 382          fatalerror("Couldn't open lock file\n");
 383 fatalerror("Couldn't get lock\n") unless(flock(LOCKFILE,LOCK_EX));
 384
 385 # Ok, now we should figure out what domains we already know about.
 386 foreach my $cfgfile (@cfgfiles) {
 387         getzones($cfgfile);
 388 }
 389
 390 # Force existance of the $domainlistroot$user file
 391 if (! -e $domainlistroot.$user) {
 392         open (DOMAINLIST, ">>$domainlistroot$user") or
 393                         fatalerror("Couldn't create domains file.\n");
 394         close DOMAINLIST;
 395 }
 396
 397 foreach (@COMMANDS) {
 398         # Remove trailing CRs and leading/trailing whitespace
 399         chomp;
 400         s/\r//;
 401         s/^\s*//;
 402         s/\s*$//;
 403
 404         if ($inprocess) {
 405                 print REPLY ">>>$_\n";
 406         }
 407
 408         if (/^$/) {
 409                 #
 410                 # Empty line, so ignore it.
 411                 #
 412         } elsif (/^END$/) {
 413                 $inprocess=0;
 414         } elsif (/^BEGIN$/) {
 415                 $inprocess=1;
 416         } elsif ($inprocess && /^ADD\s+(.*)$/) {
 417                 $domain = $1;
 418
 419                 # Convert domain to lower case.
 420                 $domain =~ tr/[A-Z]/[a-z]/;
 421                 if (! valid_domain($domain)) {
 422                         $domain =~ s/[-a-z0-9.]//g;
 423                         print REPLY "Invalid character(s) in domain name: $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: $domain\n";
 460                 } elsif (!defined($zones{$domain}) || !$zones{$domain}) {
 461                                 print REPLY "$domain does not exist!\n";
 462                 } else {
 463                         print REPLY "Deleting domain $domain\n";
 464                         my (@newcfg,$found);
 465
 466                         open (DOMAINLIST, "<$domainlistroot$user") or
 467                                 fatalerror("Couldn't open file $domainlistroot$user for reading: $!.\n");
 468                         my @cfg = <DOMAINLIST>;
 469                         close(DOMAINLIST);
 470                         @newcfg = grep { ! /^$domain$/ } @cfg;
 471                         if (scalar @cfg == scalar @newcfg) {
 472                                 print REPLY "Didn't find $domain in $domainlistroot$user!\n";
 473                                 print REPLY "You are only allowed to delete your own domains that exist.\n";
 474                                 next;
 475                         }
 476
 477                         open (DOMAINLIST, ">$domainlistroot$user") or
 478                                 fatalerror("Couldn't open file $domainlistroot$user for writing: $!.\n");
 479                         print DOMAINLIST @newcfg;
 480                         close DOMAINLIST;
 481
 482                         $found=0;
 483                         @newcfg=();
 484                         open (DOMAINSFILE, "<$conffile") or
 485                                 fatalerror("Couldn't open file $conffile for reading: $!\n");
 486                         {
 487                         local $/ = ''; # eat whole paragraphs
 488                         while (<DOMAINSFILE>) {
 489                                 unless (/^\s*zone\s+"$domain"/) {
 490                                         push @newcfg, $_;
 491                                 } else {
 492                                         $found=1;
 493                                         if ($newcfg[-1] =~ /^###/) {
 494                                                 # remove comment and \n
 495                                                 pop @newcfg;
 496                                         }
 497                                 }
 498                         }
 499                         } # end of paragraph eating
 500
 501                         if (!$found) {
 502                                 print REPLY "Didn't find $domain in $conffile!\n";
 503                                 next;
 504                         }
 505
 506                         open (DOMAINSFILE, ">$conffile") or
 507                                 fatalerror("Couldn't open $conffile for writing: $!\n");
 508                         print DOMAINSFILE @newcfg;
 509                         close DOMAINSFILE;
 510                         $delcount++;
 511                         $zones{$domain} = 0;
 512                 }
 513         } elsif ($inprocess && /^LIST$/) {
 514                 print REPLY "Listing domains for user $user\n";
 515                 print REPLY "------\n";
 516                 if (open (DOMAINLIST, "<$domainlistroot$user")) {
 517                         my $count = 0;
 518                         while (<DOMAINLIST>) {
 519                                 $count++;
 520                                 print REPLY;
 521                         }
 522                         close (DOMAINLIST);
 523                         print REPLY "------\n";
 524                         print REPLY "Total of $count domains.\n";
 525                 } else {
 526                         print REPLY "Couldn't open $domainlistroot$user: $!\n";
 527                 }
 528         } elsif ($inprocess && /^MASTER\s(.*)$/) {
 529                 if (($priv & 1) != 1) {
 530                         print REPLY "You're not authorised to use the MASTER ",
 531                                 "command.\n";
 532                 } elsif ($1 =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/) {
 533                         $server = $1;
 534                         print REPLY "Set master IP address to $1\n";
 535                 } else {
 536                         print REPLY "$1 doesn't look like a valid IPv4 ",
 537                                 "address to me.\n";
 538                 }
 539         } elsif ($inprocess && /^ADDUSER\s(.*)$/) {
 540                 if (($priv & 2) != 2) {
 541                         print REPLY "You're not authorised to use the ",
 542                                 "ADDUSER command.\n";
 543                 } elsif ($1 =~ /^([a-z0-9]+) ([A-Fa-f0-9]{8}) (\d+) (\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/) {
 544                         addautodnsuser($1, $2, $3, $4);
 545
 546                         print REPLY "Attempting to import new key:\n";
 547
 548                         # Feed our command mail to GPG so we can pull the
 549                         # (hopefully included) new GPG key out from it.
 550                         my $pid = open3(\*GPGIN, \*GPGOUT, \*GPGERR,
 551                                         "gpg --batch --import");
 552
 553                         # Feed it the mail.
 554                         print GPGIN join("\n", @COMMANDS);
 555                         close GPGIN;
 556
 557                         # And grab what it has to say.
 558                         @GPGERROR=<GPGERR>;
 559                         my @GPGOUTPUT=<GPGOUT>;
 560                         close GPGERR;
 561                         close GPGOUT;
 562                         waitpid $pid, 0;
 563
 564                         print REPLY @GPGERROR;
 565                 } else {
 566                         print REPLY "ADDUSER parameter error.\n";
 567                 }
 568         } elsif ($inprocess && /^HELP$/) {
 569                 print REPLY "In order to use the service, you will need to send GPG signed\n";
 570                 print REPLY "messages.\n\n";
 571                 print REPLY "The format of the text in these messages is important, as they represent\n";
 572                 print REPLY "commands to autodns. Commands are formatted one per line, and enclosed\n";
 573                 print REPLY "by \"BEGIN\" and \"END\" commands (without the quotes).\n";
 574                 print REPLY "Current valid commands are:\n";
 575                 print REPLY "BEGIN - begin processing.\n";
 576                 print REPLY "END - end processing.\n";
 577                 print REPLY "HELP - display this message.\n";
 578                 print REPLY "LIST - show all the zones currently held by you.\n";
 579                 print REPLY "ADD <domain> - adds the domain <domain> for processing.\n";
 580                 print REPLY "DEL <domain> - removes the domain <domain> if you own it.\n";
 581                 if (($priv & 1) == 1) {
 582                         print REPLY "MASTER <ip address> - set the nameserver".
 583                         " we should slave off for subsequent ADD\ncommands.\n";
 584                 }
 585                 if (($priv & 2) == 2) {
 586                         print REPLY "ADDUSER <username> <keyid> <privilege> ",
 587                                 "<masterip> - add a new user. Imports any key",
 588                                 "\nattached to the message into the keyring.\n";
 589                 }
 590         } elsif ($inprocess) {
 591                 print REPLY "Unknown command!\n";
 592         }
 593 }
 594 flock(LOCKFILE, LOCK_UN);
 595 close(LOCKFILE);
 596 unlink($lockfile);
 597
 598 print REPLY "Added $addcount domains.\n" if $addcount;
 599 print REPLY "Removed $delcount domains.\n" if $delcount;
 600 if ($addcount || $delcount) {
 601         print REPLY "Reloading nameserver config.\n";
 602         print REPLY `$reload_command`;
 603 }
 604 close REPLY;
 605
 606 exit 0;