autodns.pl

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