autodns.pl

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