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