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::Temp qw(tempfile);
  15 use IPC::Open3;
  16 use MIME::Parser;
  17
  18 $ENV{'PATH'}="/usr/local/bin:/usr/bin:/bin:/usr/sbin";
  19
  20 my ($from, $subject, $gpguser, $gpggood, $priv);
  21 my ($user, $server, $inprocess, $delcount, $addcount);
  22 my ($domain, @MAIL, @GPGERROR, @COMMANDS, %zones, $VERSION);
  23
  24 use vars qw($me $ccreply $conffile $domainlistroot @cfgfiles $usersfile
  25         $lockfile $reload_command $expiry);
  26
  27 $VERSION="0.0.8";
  28
  29 #
  30 # Load our config
  31 #
  32 my $file = '/etc/bind/autodns.conf';
  33 unless (my $ret = do $file) {
  34         warn "Couldn't parse $file\n" if $@;
  35         warn "Couldn't do $file\n" unless defined $ret;
  36         warn "Couldn't run $file\n" unless $ret;
  37         die "Problem reading config file!\n";
  38 }
  39
  40 ###
  41 ### There should be no need to edit anything below (unless you're not
  42 ### using BIND). This statement might even be true now - let me know if not.
  43 ###
  44
  45 #
  46 # Try to figure out what zones we currently know about by parsing config
  47 # files. Sets the item in %zones to 1 for each zone it finds.
  48 #
  49 # Call with the name of a config file to read:
  50 #
  51 # getzones("/etc/named.conf");
  52 #
  53 sub getzones($) {
  54         my $namedfile = shift;
  55
  56         open (NAMEDCONF, "< $namedfile") or
  57                 fatalerror("Can't open $namedfile");
  58
  59         while (<NAMEDCONF>) {
  60                 if (/^\s*zone\s*"([^"]+)"/) {
  61                         $zones{$1}=1;
  62                 }
  63         }
  64
  65         close NAMEDCONF;
  66 }
  67
  68 #
  69 # Check that a domain is only made up of valid characters.
  70 #
  71 # These are: a-z, 0-9, - or .
  72 #
  73 sub valid_domain($) {
  74         my $domain = shift;
  75         $domain = lc $domain;
  76
  77         if ($domain =~ /^(?:[a-z0-9-]+\.)+[a-z]{2,6}$/) {
  78                 return 1;
  79         } elsif ($domain =~ /^(?:[0-9\/-]+\.)+in-addr.arpa$/) {
  80                 return 1;
  81         } else {
  82                 return 0;
  83         }
  84 }
  85
  86 #
  87 # Deal with a fatal error by printing an error message, closing the pipe to
  88 # sendmail and exiting.
  89 #
  90 # fatalerror("I'm melting!");
  91 #
  92 sub fatalerror($) {
  93         my $message = shift;
  94
  95         print REPLY $message;
  96         close(REPLY);
  97
  98         flock(LOCKFILE, LOCK_UN);
  99         close(LOCKFILE);
 100         unlink($lockfile);
 101
 102 #       die $message;
 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>:<priviledge 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, $priviledge, $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                         $priviledge=$2;
 128                         $server=$3;
 129                         chomp $user;
 130                         chomp $priviledge;
 131                         chomp $server;
 132
 133                         if ($user !~ /^.+$/) {
 134                                 close(CONFIGFILE);
 135                                 fatalerror("Error in user configuration file: Can't get username.\n");
 136                         }
 137
 138                         if ($server !~ /^(\d{1,3}\.){3}\d{1,3}$/) {
 139                                 $server =~ s/\d\.]//g;
 140                                 close(CONFIGFILE);
 141                                 fatalerror("Error in user configuration file: Invalid primary server IP address ($server)\n");
 142                                 exit;
 143                         }
 144                 }
 145         }
 146         close(CONFIGFILE);
 147
 148         if ($user =~ /^$/) {
 149                 fatalerror("User not found.\n");
 150         }
 151
 152         return ($user, $priviledge, $server);
 153 }
 154
 155 $delcount=$addcount=$inprocess=0;
 156
 157 # Read in the mail from stdin.
 158 @MAIL=<>;
 159
 160 $subject = "Reply from AutoDNS";
 161 # Now lets try to find out who it's from.
 162 foreach (@MAIL) {
 163         if (/^$/) { last; }
 164         if (/^From: (.*)/i) { $from=$1; chomp $from;}
 165         if (/^Subject:\s+(re:)?(.*)$/i) { $subject="Re: ".$2 if ($2);}
 166 }
 167
 168 if ((! defined($from)) || $from =~ /^$/ ) {
 169         die "Couldn't find a from address.";
 170 } elsif ($from =~ /mailer-daemon@/i) {
 171         die "From address is mailer-daemon, ignoring.";
 172 }
 173
 174 if (! defined($subject)) { $subject="Reply from AutoDNS"; };
 175
 176 # We've got a from address. Start a reply.
 177
 178 open(REPLY, "|sendmail -t -oem -oi") or die "Couldn't spawn sendmail";
 179
 180 print REPLY "From: $me\n";
 181 print REPLY "To: $from\n";
 182 #
 183 # Check to see if our CC address is the same as the from address and if so
 184 # don't CC.
 185 #
 186 if ($from ne $ccreply) {
 187         print REPLY "Cc: $ccreply\n";
 188 }
 189 print REPLY <<EOF;
 190 Subject: $subject
 191
 192 AutoDNS $VERSION
 193 Copyright 1999-2004 Project Purple. Written by Jonathan McDowell.
 194 Released under the GPL.
 195
 196 EOF
 197
 198 #
 199 # Throw the mail at MIME::Parser and see if it accepts it.
 200 #
 201 my $parser = new MIME::Parser;
 202 $parser->output_to_core(1); # No temporary files
 203 my $entity = $parser->parse_data(\@MAIL);
 204
 205 #
 206 # Make sure locale is set to C so we get messages in English as we expect.
 207 #
 208 $ENV{'LC_ALL'}="C";
 209
 210 if ($entity->parts) {
 211         # MIME
 212
 213         my ($got_sig, $got_text) = (0, 0);
 214         my ($sig_name,$sig_fh,$text_name,$text_fh);
 215         ($sig_fh, $sig_name) = tempfile();
 216         ($text_fh, $text_name) = tempfile();
 217
 218         foreach my $subent ($entity->parts) {
 219                 if ($subent->effective_type eq "text/plain") {
 220                         @COMMANDS = split /\n/,$subent->bodyhandle->as_string;
 221
 222                         my $str = $subent->as_string;
 223                         $str =~ s/=\n$//;
 224                         $str =~ s/\n/\r\n/g;
 225                         print $text_fh $str;
 226                         close($text_fh);
 227                         $got_text++;
 228                 } elsif ($subent->effective_type eq
 229                                 "application/pgp-signature") {
 230                         print $sig_fh $subent->as_string;
 231                         close($sig_fh);
 232                         $got_sig++;
 233                 }
 234         }
 235
 236         if ($got_sig && $got_text) {
 237                 my $pid = open3(\*GPGIN, \*GPGOUT, \*GPGERR,
 238                         "gpg --batch --verify ".
 239                         $sig_name." ".$text_name);
 240
 241                 close GPGIN;
 242
 243                 @GPGERROR=<GPGERR>;
 244                 my @GPGOUTPUT=<GPGOUT>;
 245                 close GPGERR;
 246                 close GPGOUT;
 247                 waitpid $pid, 0;
 248
 249                 unlink($text_name);
 250                 unlink($sig_name);
 251         }
 252 } else {
 253         # Clear text.
 254
 255         my $pid = open3(\*GPGIN, \*GPGOUT, \*GPGERR, "gpg --batch --verify");
 256
 257         # Feed it the mail.
 258         print GPGIN $entity->bodyhandle->as_string;
 259         close GPGIN;
 260
 261         # And grab what it has to say.
 262         @GPGERROR=<GPGERR>;
 263         @COMMANDS=<GPGOUT>;
 264         @COMMANDS = split /\n/,$entity->bodyhandle->as_string;
 265         close GPGERR;
 266         close GPGOUT;
 267         waitpid $pid, 0;
 268 }
 269
 270 # Check who it's from and if the signature was a good one.
 271 $gpggood=1;
 272 my $sigtime = 0;
 273 foreach (@GPGERROR) {
 274         chomp;
 275         if (/Signature made (.*) using.*ID (.*)$/) {
 276                 $sigtime = str2time($1);
 277                 $gpguser=$2;
 278         } elsif (/error/) {
 279                 $gpggood = 0;
 280                 print REPLY "Some errors ocurred\n";
 281         } elsif (/BAD signature/) {
 282                 $gpggood = 0;
 283                 print REPLY "BAD signature!\n";
 284         } elsif (/public key not found/) {
 285                 $gpggood = 0;
 286                 print REPLY "Public Key not found\n";
 287         }
 288 }
 289
 290 # If we have an empty user it probably wasn't signed.
 291 if (! $gpguser) {
 292         print REPLY "Message appears not to be GPG signed.\n";
 293         close REPLY;
 294         exit;
 295 }
 296
 297 # Check the signature we got was ok.
 298 if ($gpggood) {
 299         print REPLY "Good GPG signature found. ($gpguser)\n";
 300 } else {
 301         print REPLY "Bad GPG signature!\n";
 302         close REPLY;
 303         exit;
 304 }
 305
 306 # Check if the signature is outside our acceptable range.
 307 if (!defined($sigtime)) {
 308         print REPLY "Couldn't parse signature time.\n";
 309         close REPLY;
 310         exit;
 311 } elsif ($sigtime > (time + $expiry)) {
 312         print REPLY "Signature too far into the future.\n";
 313         close REPLY;
 314         exit;
 315 } elsif ($sigtime < (time - $expiry)) {
 316         print REPLY "Signature too far into the past.\n";
 317         close REPLY;
 318         exit;
 319 }
 320
 321 # Now let's check if we know this person.
 322 ($user, $priv, $server) = getuserinfo($gpguser);
 323
 324 if (! defined($user) || ! $user) {
 325         print REPLY "Unknown user.\n";
 326         close REPLY;
 327         exit;
 328 }
 329
 330 print REPLY "Got user '$user'\n";
 331
 332 # Right. We know this is a valid user. Get a lock to ensure we have exclusive
 333 # access to the configs from here on in.
 334 open (LOCKFILE,">$lockfile") ||
 335          fatalerror("Couldn't open lock file\n");
 336 fatalerror("Couldn't get lock\n") unless(flock(LOCKFILE,LOCK_EX));
 337
 338 # Ok, now we should figure out what domains we already know about.
 339 foreach my $cfgfile (@cfgfiles) {
 340         getzones($cfgfile);
 341 }
 342
 343 # Force existance of the $domainlistroot$user file
 344 if (! -e $domainlistroot.$user) {
 345         open (DOMAINLIST, ">>$domainlistroot$user") or
 346                         fatalerror("Couldn't create domains file.\n");
 347         close DOMAINLIST;
 348 }
 349
 350 foreach (@COMMANDS) {
 351         # Remove trailing CRs and leading/trailing whitespace
 352         chomp;
 353         s/\r//;
 354         s/^\s*//;
 355         s/\s*$//;
 356
 357         if ($inprocess) {
 358                 print REPLY ">>>$_\n";
 359         }
 360
 361         if (/^$/) {
 362                 #
 363                 # Empty line, so ignore it.
 364                 #
 365         } elsif (/^END$/) {
 366                 $inprocess=0;
 367         } elsif (/^BEGIN$/) {
 368                 $inprocess=1;
 369         } elsif ($inprocess && /^ADD\s+(.*)$/) {
 370                 $domain = $1;
 371
 372                 # Convert domain to lower case.
 373                 $domain =~ tr/[A-Z]/[a-z]/;
 374                 if (! valid_domain($domain)) {
 375                         $domain =~ s/[-a-z0-9.]//g;
 376                         print REPLY "Invalid character(s) in domain name: $domain\n";
 377                 } elsif (defined($zones{$domain}) && $zones{$domain}) {
 378                         print REPLY "We already secondary $domain\n";
 379                 } else {
 380                         print REPLY "Adding domain $domain\n";
 381                         $zones{$domain}=1;
 382
 383                         my $df = $domain;
 384                         $df =~ tr,/,:,;
 385
 386                         open (DOMAINSFILE, ">>$conffile");
 387                         print DOMAINSFILE "
 388 ### Domain added for '$user'
 389
 390 zone \"$domain\" {
 391         type slave;
 392         masters { $server; };
 393         file \"secondary/$user/$df\";
 394         allow-transfer { none; };
 395         allow-query { any; };
 396 };\n";
 397                         close DOMAINSFILE;
 398
 399                         open (DOMAINLIST, ">>$domainlistroot$user") or
 400                                 fatalerror("Couldn't open file.\n");
 401                         print DOMAINLIST "$domain\n";
 402                         close DOMAINLIST;
 403                         $addcount++;
 404                 }
 405         } elsif ($inprocess && /^DEL\s(.*)$/) {
 406                 $domain = $1;
 407
 408                 # Convert domain to lower case.
 409                 $domain =~ tr/[A-Z]/[a-z]/;
 410                 if (!valid_domain($domain)) {
 411                         $domain =~ s/[-a-z0-9.]//g;
 412                         print REPLY "Invalid character(s) in domain name: $domain\n";
 413                 } elsif (!defined($zones{$domain}) || !$zones{$domain}) {
 414                                 print REPLY "$domain does not exist!\n";
 415                 } else {
 416                         print REPLY "Deleting domain $domain\n";
 417                         my (@newcfg,$found);
 418
 419                         open (DOMAINLIST, "<$domainlistroot$user") or
 420                                 fatalerror("Couldn't open file $domainlistroot$user for reading: $!.\n");
 421                         my @cfg = <DOMAINLIST>;
 422                         close(DOMAINLIST);
 423                         @newcfg = grep { ! /^$domain$/ } @cfg;
 424                         if (scalar @cfg == scalar @newcfg) {
 425                                 print REPLY "Didn't find $domain in $domainlistroot$user!\n";
 426                                 print REPLY "You are only allowed to delete your own domains that exist.\n";
 427                                 next;
 428                         }
 429
 430                         open (DOMAINLIST, ">$domainlistroot$user") or
 431                                 fatalerror("Couldn't open file $domainlistroot$user for writing: $!.\n");
 432                         print DOMAINLIST @newcfg;
 433                         close DOMAINLIST;
 434
 435                         $found=0;
 436                         @newcfg=();
 437                         open (DOMAINSFILE, "<$conffile") or
 438                                 fatalerror("Couldn't open file $conffile for reading: $!\n");
 439                         {
 440                         local $/ = ''; # eat whole paragraphs
 441                         while (<DOMAINSFILE>) {
 442                                 unless (/^\s*zone\s+"$domain"/) {
 443                                         push @newcfg, $_;
 444                                 } else {
 445                                         $found=1;
 446                                         if ($newcfg[-1] =~ /^###/) {
 447                                                 # remove comment and \n
 448                                                 pop @newcfg;
 449                                         }
 450                                 }
 451                         }
 452                         } # end of paragraph eating
 453
 454                         if (!$found) {
 455                                 print REPLY "Didn't find $domain in $conffile!\n";
 456                                 next;
 457                         }
 458
 459                         open (DOMAINSFILE, ">$conffile") or
 460                                 fatalerror("Couldn't open $conffile for writing: $!\n");
 461                         print DOMAINSFILE @newcfg;
 462                         close DOMAINSFILE;
 463                         $delcount++;
 464                         $zones{$domain} = 0;
 465                 }
 466         } elsif ($inprocess && /^LIST$/) {
 467                 print REPLY "Listing domains for user $user\n";
 468                 print REPLY "------\n";
 469                 if (open (DOMAINLIST, "<$domainlistroot$user")) {
 470                         my $count = 0;
 471                         while (<DOMAINLIST>) {
 472                                 $count++;
 473                                 print REPLY;
 474                         }
 475                         close (DOMAINLIST);
 476                         print REPLY "------\n";
 477                         print REPLY "Total of $count domains.\n";
 478                 } else {
 479                         print REPLY "Couldn't open $domainlistroot$user: $!\n";
 480                 }
 481         } elsif ($inprocess && /^MASTER\s(.*)$/) {
 482                 if (($priv & 1) != 1) {
 483                         print REPLY "You're not authorised to use the MASTER ",
 484                                 "command.\n";
 485                 } elsif ($1 =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/) {
 486                         $server = $1;
 487                         print REPLY "Set master IP address to $1\n";
 488                 } else {
 489                         print REPLY "$1 doesn't look like a valid IPv4 ",
 490                                 "address to me.\n";
 491                 }
 492         } elsif ($inprocess && /^HELP$/) {
 493                 print REPLY "In order to use the service, you will need to send GPG signed\n";
 494                 print REPLY "messages.\n\n";
 495                 print REPLY "The format of the text in these messages is important, as they represent\n";
 496                 print REPLY "commands to autodns. Commands are formatted one per line, and enclosed\n";
 497                 print REPLY "by \"BEGIN\" and \"END\" commands (without the quotes).\n";
 498                 print REPLY "Current valid commands are:\n";
 499                 print REPLY "BEGIN - begin processing.\n";
 500                 print REPLY "END - end processing.\n";
 501                 print REPLY "HELP - display this message.\n";
 502                 print REPLY "LIST - show all the zones currently held by you.\n";
 503                 print REPLY "ADD <domain> - adds the domain <domain> for processing.\n";
 504                 print REPLY "DEL <domain> - removes the domain <domain> if you own it.\n";
 505                 if (($priv & 1) == 1) {
 506                         print REPLY "MASTER <ip address> - set the nameserver".
 507                         " we should slave off for subsequent ADD commands.\n";
 508                 }
 509         } elsif ($inprocess) {
 510                 print REPLY "Unknown command!\n";
 511         }
 512 }
 513 flock(LOCKFILE, LOCK_UN);
 514 close(LOCKFILE);
 515 unlink($lockfile);
 516
 517 print REPLY "Added $addcount domains.\n" if $addcount;
 518 print REPLY "Removed $delcount domains.\n" if $delcount;
 519 if ($addcount || $delcount) {
 520         print REPLY "Reloading nameserver config.\n";
 521         print REPLY `$reload_command`;
 522 }
 523 close REPLY;
 524
 525 exit 0;