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.13 2005/05/31 17:17:46 noodles Exp $
   9 #
  10
  11 use strict;
  12 use Fcntl qw(:flock);
  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);
  25
  26 $VERSION="0.0.8";
  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,4}$/) {
  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 #       die $message;
 102         exit;
 103 }
 104
 105 #
 106 # Get user details from usersfile based on a PGP ID.
 107 #
 108 # A users entry looks like:
 109 #
 110 # <username>:<keyid>:<priviledge level>:<master server ip>
 111 #
 112 # Priviledge level is not currently used.
 113 #
 114 # ($user, $priv, $server) = getuserinfo("5B430367");
 115 #
 116 sub getuserinfo($) {
 117         my $gpguser = shift;
 118         my ($user, $priviledge, $server);
 119
 120         open (CONFIGFILE, "< $usersfile") or
 121                 fatalerror("Couldn't open user configuration file.");
 122
 123         foreach (<CONFIGFILE>) {
 124                 if (/^([^#.]+):$gpguser:(\d+):(.+)$/) {
 125                         $user=$1;
 126                         $priviledge=$2;
 127                         $server=$3;
 128                         chomp $user;
 129                         chomp $priviledge;
 130                         chomp $server;
 131
 132                         if ($user !~ /^.+$/) {
 133                                 close(CONFIGFILE);
 134                                 fatalerror("Error in user configuration 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 file: Invalid primary server IP address ($server)\n");
 141                                 exit;
 142                         }
 143                 }
 144         }
 145         close(CONFIGFILE);
 146
 147         if ($user =~ /^$/) {
 148                 fatalerror("User not found.\n");
 149         }
 150
 151         return ($user, $priviledge, $server);
 152 }
 153
 154 $delcount=$addcount=$inprocess=0;
 155
 156 # Read in the mail from stdin.
 157 @MAIL=<>;
 158
 159 $subject = "Reply from AutoDNS";
 160 # Now lets try to find out who it's from.
 161 foreach (@MAIL) {
 162         if (/^$/) { last; }
 163         if (/^From: (.*)/i) { $from=$1; chomp $from;}
 164         if (/^Subject:\s+(re:)?(.*)$/i) { $subject="Re: ".$2 if ($2);}
 165 }
 166
 167 if ((! defined($from)) || $from =~ /^$/ ) {
 168         die "Couldn't find a from address.";
 169 } elsif ($from =~ /mailer-daemon@/i) {
 170         die "From address is mailer-daemon, ignoring.";
 171 }
 172
 173 if (! defined($subject)) { $subject="Reply from AutoDNS"; };
 174
 175 # We've got a from address. Start a reply.
 176
 177 open(REPLY, "|sendmail -t -oem -oi") or die "Couldn't spawn sendmail";
 178
 179 print REPLY "From: $me\n";
 180 print REPLY "To: $from\n";
 181 #
 182 # Check to see if our CC address is the same as the from address and if so
 183 # don't CC.
 184 #
 185 if ($from ne $ccreply) {
 186         print REPLY "Cc: $ccreply\n";
 187 }
 188 print REPLY <<EOF;
 189 Subject: $subject
 190
 191 AutoDNS $VERSION
 192 Copyright 1999-2004 Project Purple. Written by Jonathan McDowell.
 193 Released under the GPL.
 194
 195 EOF
 196
 197 #
 198 # Throw the mail at MIME::Parser and see if it accepts it.
 199 #
 200 my $parser = new MIME::Parser;
 201 $parser->output_to_core(1); # No temporary files
 202 my $entity = $parser->parse_data(\@MAIL);
 203
 204 #
 205 # Make sure locale is set to C so we get messages in English as we expect.
 206 #
 207 $ENV{'LC_ALL'}="C";
 208
 209 if ($entity->parts) {
 210         # MIME
 211
 212         my ($got_sig, $got_text) = (0, 0);
 213         my ($sig_name,$sig_fh,$text_name,$text_fh);
 214         ($sig_fh, $sig_name) = tempfile();
 215         ($text_fh, $text_name) = tempfile();
 216
 217         foreach my $subent ($entity->parts) {
 218                 if ($subent->effective_type eq "text/plain") {
 219                         @COMMANDS = split /\n/,$subent->bodyhandle->as_string;
 220
 221                         my $str = $subent->as_string;
 222                         $str =~ s/=\n$//;
 223                         $str =~ s/\n/\r\n/g;
 224                         print $text_fh $str;
 225                         close($text_fh);
 226                         $got_text++;
 227                 } elsif ($subent->effective_type eq
 228                                 "application/pgp-signature") {
 229                         print $sig_fh $subent->as_string;
 230                         close($sig_fh);
 231                         $got_sig++;
 232                 }
 233         }
 234
 235         if ($got_sig && $got_text) {
 236                 my $pid = open3(\*GPGIN, \*GPGOUT, \*GPGERR,
 237                         "gpg --batch --verify ".
 238                         $sig_name." ".$text_name);
 239
 240                 close GPGIN;
 241
 242                 @GPGERROR=<GPGERR>;
 243                 my @GPGOUTPUT=<GPGOUT>;
 244                 close GPGERR;
 245                 close GPGOUT;
 246                 waitpid $pid, 0;
 247
 248                 unlink($text_name);
 249                 unlink($sig_name);
 250         }
 251 } else {
 252         # Clear text.
 253
 254         my $pid = open3(\*GPGIN, \*GPGOUT, \*GPGERR, "gpg --batch");
 255
 256         # Feed it the mail.
 257         print GPGIN $entity->bodyhandle->as_string;
 258         close GPGIN;
 259
 260         # And grab what it has to say.
 261         @GPGERROR=<GPGERR>;
 262         @COMMANDS=<GPGOUT>;
 263         close GPGERR;
 264         close GPGOUT;
 265         waitpid $pid, 0;
 266 }
 267
 268 # Check who it's from and if the signature was a good one.
 269 $gpggood=1;
 270 foreach (@GPGERROR) {
 271         chomp;
 272         if (/Signature made.* (.*)$/) {
 273                 $gpguser=$1;
 274         } elsif (/error/) {
 275                 $gpggood = 0;
 276                 print REPLY "Some errors ocurred\n";
 277         } elsif (/BAD signature/) {
 278                 $gpggood = 0;
 279                 print REPLY "BAD signature!\n";
 280         } elsif (/public key not found/) {
 281                 $gpggood = 0;
 282                 print REPLY "Public Key not found\n";
 283         }
 284 }
 285
 286 # If we have an empty user it probably wasn't signed.
 287 if (! $gpguser) {
 288         print REPLY "Message appears not to be GPG signed.\n";
 289         close REPLY;
 290         exit;
 291 }
 292
 293 # Check the signature we got was ok.
 294 if ($gpggood) {
 295         print REPLY "Good GPG signature found. ($gpguser)\n";
 296 } else {
 297         print REPLY "Bad GPG signature!\n";
 298         close REPLY;
 299         exit;
 300 }
 301
 302 # Now let's check if we know this person.
 303 ($user, $priv, $server) = getuserinfo($gpguser);
 304
 305 if (! defined($user) || ! $user) {
 306         print REPLY "Unknown user.\n";
 307         close REPLY;
 308         exit;
 309 }
 310
 311 print REPLY "Got user '$user'\n";
 312
 313 # Right. We know this is a valid user. Get a lock to ensure we have exclusive
 314 # access to the configs from here on in.
 315 open (LOCKFILE,">$lockfile") ||
 316          fatalerror("Couldn't open lock file\n");
 317 fatalerror("Couldn't get lock\n") unless(flock(LOCKFILE,LOCK_EX));
 318
 319 # Ok, now we should figure out what domains we already know about.
 320 foreach my $cfgfile (@cfgfiles) {
 321         getzones($cfgfile);
 322 }
 323
 324 # Force existance of the $domainlistroot$user file
 325 if (! -e $domainlistroot.$user) {
 326         open (DOMAINLIST, ">>$domainlistroot$user") or
 327                         fatalerror("Couldn't create domains file.\n");
 328         close DOMAINLIST;
 329 }
 330
 331 foreach (@COMMANDS) {
 332         # Remove trailing CRs and leading/trailing whitespace
 333         chomp;
 334         s/\r//;
 335         s/^\s*//;
 336         s/\s*$//;
 337
 338         if ($inprocess) {
 339                 print REPLY ">>>$_\n";
 340         }
 341
 342         if (/^$/) {
 343                 #
 344                 # Empty line, so ignore it.
 345                 #
 346         } elsif (/^END$/) {
 347                 $inprocess=0;
 348         } elsif (/^BEGIN$/) {
 349                 $inprocess=1;
 350         } elsif ($inprocess && /^ADD\s+(.*)$/) {
 351                 $domain = $1;
 352
 353                 # Convert domain to lower case.
 354                 $domain =~ tr/[A-Z]/[a-z]/;
 355                 if (! valid_domain($domain)) {
 356                         $domain =~ s/[-a-z0-9.]//g;
 357                         print REPLY "Invalid character(s) in domain name: $domain\n";
 358                 } elsif (defined($zones{$domain}) && $zones{$domain}) {
 359                         print REPLY "We already secondary $domain\n";
 360                 } else {
 361                         print REPLY "Adding domain $domain\n";
 362                         $zones{$domain}=1;
 363
 364                         my $df = $domain;
 365                         $df =~ tr,/,:,;
 366
 367                         open (DOMAINSFILE, ">>$conffile");
 368                         print DOMAINSFILE "
 369 ### Domain added for '$user'
 370
 371 zone \"$domain\" {
 372         type slave;
 373         masters { $server; };
 374         file \"secondary/$user/$df\";
 375         allow-transfer { none; };
 376         allow-query { any; };
 377 };\n";
 378                         close DOMAINSFILE;
 379
 380                         open (DOMAINLIST, ">>$domainlistroot$user") or
 381                                 fatalerror("Couldn't open file.\n");
 382                         print DOMAINLIST "$domain\n";
 383                         close DOMAINLIST;
 384                         $addcount++;
 385                 }
 386         } elsif ($inprocess && /^DEL\s(.*)$/) {
 387                 $domain = $1;
 388
 389                 # Convert domain to lower case.
 390                 $domain =~ tr/[A-Z]/[a-z]/;
 391                 if (!valid_domain($domain)) {
 392                         $domain =~ s/[-a-z0-9.]//g;
 393                         print REPLY "Invalid character(s) in domain name: $domain\n";
 394                 } elsif (!defined($zones{$domain}) || !$zones{$domain}) {
 395                                 print REPLY "$domain does not exist!\n";
 396                 } else {
 397                         print REPLY "Deleting domain $domain\n";
 398                         my (@newcfg,$found);
 399
 400                         open (DOMAINLIST, "<$domainlistroot$user") or
 401                                 fatalerror("Couldn't open file $domainlistroot$user for reading: $!.\n");
 402                         my @cfg = <DOMAINLIST>;
 403                         close(DOMAINLIST);
 404                         @newcfg = grep { ! /^$domain$/ } @cfg;
 405                         if (scalar @cfg == scalar @newcfg) {
 406                                 print REPLY "Didn't find $domain in $domainlistroot$user!\n";
 407                                 print REPLY "You are only allowed to delete your own domains that exist.\n";
 408                                 next;
 409                         }
 410
 411                         open (DOMAINLIST, ">$domainlistroot$user") or
 412                                 fatalerror("Couldn't open file $domainlistroot$user for writing: $!.\n");
 413                         print DOMAINLIST @newcfg;
 414                         close DOMAINLIST;
 415
 416                         $found=0;
 417                         @newcfg=();
 418                         open (DOMAINSFILE, "<$conffile") or
 419                                 fatalerror("Couldn't open file $conffile for reading: $!\n");
 420                         {
 421                         local $/ = ''; # eat whole paragraphs
 422                         while (<DOMAINSFILE>) {
 423                                 unless (/^\s*zone\s+"$domain"/) {
 424                                         push @newcfg, $_;
 425                                 } else {
 426                                         $found=1;
 427                                         if ($newcfg[-1] =~ /^###/) {
 428                                                 # remove comment and \n
 429                                                 pop @newcfg;
 430                                         }
 431                                 }
 432                         }
 433                         } # end of paragraph eating
 434
 435                         if (!$found) {
 436                                 print REPLY "Didn't find $domain in $conffile!\n";
 437                                 next;
 438                         }
 439
 440                         open (DOMAINSFILE, ">$conffile") or
 441                                 fatalerror("Couldn't open $conffile for writing: $!\n");
 442                         print DOMAINSFILE @newcfg;
 443                         close DOMAINSFILE;
 444                         $delcount++;
 445                         $zones{$domain} = 0;
 446                 }
 447         } elsif ($inprocess && /^LIST$/) {
 448                 print REPLY "Listing domains for user $user\n";
 449                 print REPLY "------\n";
 450                 if (open (DOMAINLIST, "<$domainlistroot$user")) {
 451                         my $count = 0;
 452                         while (<DOMAINLIST>) {
 453                                 $count++;
 454                                 print REPLY;
 455                         }
 456                         close (DOMAINLIST);
 457                         print REPLY "------\n";
 458                         print REPLY "Total of $count domains.\n";
 459                 } else {
 460                         print REPLY "Couldn't open $domainlistroot$user: $!\n";
 461                 }
 462         } elsif ($inprocess && /^MASTER\s(.*)$/) {
 463                 if (($priv & 1) != 1) {
 464                         print REPLY "You're not authorised to use the MASTER ",
 465                                 "command.\n";
 466                 } elsif ($1 =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/) {
 467                         $server = $1;
 468                         print REPLY "Set master IP address to $1\n";
 469                 } else {
 470                         print REPLY "$1 doesn't look like a valid IPv4 ",
 471                                 "address to me.\n";
 472                 }
 473         } elsif ($inprocess && /^HELP$/) {
 474                 print REPLY "In order to use the service, you will need to send GPG signed\n";
 475                 print REPLY "messages.\n\n";
 476                 print REPLY "The format of the text in these messages is important, as they represent\n";
 477                 print REPLY "commands to autodns. Commands are formatted one per line, and enclosed\n";
 478                 print REPLY "by \"BEGIN\" and \"END\" commands (without the quotes).\n";
 479                 print REPLY "Current valid commands are:\n";
 480                 print REPLY "BEGIN - begin processing.\n";
 481                 print REPLY "END - end processing.\n";
 482                 print REPLY "HELP - display this message.\n";
 483                 print REPLY "LIST - show all the zones currently held by you.\n";
 484                 print REPLY "ADD <domain> - adds the domain <domain> for processing.\n";
 485                 print REPLY "DEL <domain> - removes the domain <domain> if you own it.\n";
 486         } elsif ($inprocess) {
 487                 print REPLY "Unknown command!\n";
 488         }
 489 }
 490 flock(LOCKFILE, LOCK_UN);
 491 close(LOCKFILE);
 492 unlink($lockfile);
 493
 494 print REPLY "Added $addcount domains.\n" if $addcount;
 495 print REPLY "Removed $delcount domains.\n" if $delcount;
 496 if ($addcount || $delcount) {
 497         print REPLY "Reloading nameserver config.\n";
 498         print REPLY `$reload_command`;
 499 }
 500 close REPLY;
 501
 502 exit 0;