autodns.pl

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