]> the.earth.li Git - autodns.git/blobdiff - autodns.pl
Release 1.0.0
[autodns.git] / autodns.pl
index 9a739d0c16be5a08035975984ac2a6c3738c6d72..df5f38e54ce727eb3566c25c0160d0d1147a4dcb 100755 (executable)
@@ -1,54 +1,40 @@
 #!/usr/bin/perl -Tw
-# autodns 0.0.5
-# Copyright 1999-2001 Project Purple. Written by Jonathan McDowell
+# autodns 1.0.0
+# Copyright 1999-2006 Project Purple. Written by Jonathan McDowell
 # See ACKNOWLEDGEMENTS file for full details of contributors.
 # http://www.earth.li/projectpurple/progs/autodns.html
 # Released under the GPL.
+#
 
 use strict;
-use IPC::Open3;
+use Date::Parse;
 use Fcntl qw(:flock);
+use File::Path;
+use File::Temp qw(tempfile);
+use IPC::Open3;
+use MIME::Parser;
 
-$ENV{'PATH'}="/usr/local/bin:/usr/bin:/bin:/usr/sbin";
+$ENV{'PATH'} = "/usr/local/bin:/usr/bin:/bin:/usr/sbin";
 
-my ($from, $subject, $gpguser, $gpggood, $usersfile, $lockfile, $priv);
-my ($user, $server, $inprocess, $delcount, $addcount, $reload_command);
-my ($domain, @MAIL, @GPGERROR, @COMMANDS, %zones);
-my ($me, $ccreply, $conffile, $domainlistroot, @cfgfiles, $VERSION);
+my ($from, $subject, $gpguser, $gpggood, $priv);
+my ($user, $server, $inprocess, $delcount, $addcount);
+my ($domain, @MAIL, @GPGERROR, @COMMANDS, %zones, $VERSION);
 
-$VERSION="0.0.5";
+use vars qw($me $ccreply $conffile $domainlistroot @cfgfiles $usersfile
+       $lockfile $reload_command $expiry $zonefiledir);
+
+$VERSION = "1.0.0";
 
 #
-# Local configuration here (until it gets moved to a config file).
-#
-# These are sort of suitable for a Debian setup.
+# Load our config
 #
-
-# Who I should reply as.
-$me="autodns\@earth.li";
-
-# Who replies should be CCed to.
-$ccreply="noodles\@earth.li";
-
-# Where to look for zones we're already hosting.
-@cfgfiles=("/etc/bind/named.conf",
-       "/etc/bind/named.secondary.conf");
-
-# The file we should add/delete domains from.
-$conffile="/etc/bind/named.secondary.conf";
-
-# The file that contains details of the authorized users.
-$usersfile="/etc/bind/autodns.users";
-
-# Base file name to for list of users domains.
-$domainlistroot="/etc/bind/domains.";
-
-# The lockfile we use to ensure we have exclusive access to the
-# $domainlistroot$user files and $conffile.
-$lockfile="/etc/bind/autodns.lck";
-
-# The command to reload the nameserver domains list.
-$reload_command="sudo ndc reconfig 2>&1";
+my $file = '/etc/bind/autodns.conf';
+unless (my $ret = do $file) {
+       warn "Couldn't parse $file\n" if $@;
+       warn "Couldn't do $file\n" unless defined $ret;
+       warn "Couldn't run $file\n" unless $ret;
+       die "Problem reading config file!\n";
+}
 
 ###
 ### There should be no need to edit anything below (unless you're not
@@ -61,13 +47,13 @@ $reload_command="sudo ndc reconfig 2>&1";
 #
 # Call with the name of a config file to read:
 #
-# &getzones("/etc/named.conf");
+# getzones("/etc/named.conf");
 #
-sub getzones {
-       my ($namedfile) = @_;
+sub getzones($) {
+       my $namedfile = shift;
 
        open (NAMEDCONF, "< $namedfile") or
-               &fatalerror("Can't open $namedfile");
+               fatalerror("Can't open $namedfile");
 
        while (<NAMEDCONF>) {
                if (/^\s*zone\s*"([^"]+)"/) {
@@ -83,14 +69,17 @@ sub getzones {
 #
 # These are: a-z, 0-9, - or .
 #
-sub valid_domain {
-       my $domain = shift;
-       $domain = lc $domain;
-       if ($domain =~ /^(?:[a-z0-9-]+\.)+[a-z]{2,4}$/) {
-               return 1;
-       } else {
-               return 0;
-       }
+sub valid_domain($) {
+       my $domain = shift;
+       $domain = lc $domain;
+
+       if ($domain =~ /^(?:[a-z0-9-]+\.)+[a-z]{2,6}$/) {
+               return 1;
+       } elsif ($domain =~ /^(?:[0-9\/-]+\.)+in-addr.arpa$/) {
+               return 1;
+       } else {
+               return 0;
+       }
 }
 
 #
@@ -99,7 +88,7 @@ sub valid_domain {
 #
 # fatalerror("I'm melting!");
 #
-sub fatalerror {
+sub fatalerror($) {
        my $message = shift;
 
        print REPLY $message;
@@ -109,7 +98,6 @@ sub fatalerror {
        close(LOCKFILE);
        unlink($lockfile);
 
-#      die $message;
        exit;
 }
 
@@ -118,37 +106,40 @@ sub fatalerror {
 #
 # A users entry looks like:
 #
-# <username>:<keyid>:<priviledge level>:<master server ip>
+# <username>:<keyid>:<privilege level>:<master server ip>
 #
 # Priviledge level is not currently used.
 #
-# ($user, $priv, $server) = &getuserinfo("5B430367");
+# ($user, $priv, $server) = getuserinfo("5B430367");
 #
-sub getuserinfo {
+sub getuserinfo($) {
        my $gpguser = shift;
-       my ($user, $priviledge, $server);
+       my ($user, $privilege, $server);
 
        open (CONFIGFILE, "< $usersfile") or
-               &fatalerror("Couldn't open user configuration file.");
+               fatalerror("Couldn't open user configuration file.");
 
        foreach (<CONFIGFILE>) {
                if (/^([^#.]+):$gpguser:(\d+):(.+)$/) {
-                       $user=$1;
-                       $priviledge=$2;
-                       $server=$3;
+                       $user = $1;
+                       $privilege = $2;
+                       $server = $3;
                        chomp $user;
-                       chomp $priviledge;
+                       chomp $privilege;
                        chomp $server;
        
                        if ($user !~ /^.+$/) {
                                close(CONFIGFILE);
-                               &fatalerror("Error in user configuration file: Can't get username.\n");
+                               fatalerror("Error in user configuration ".
+                                               "file: Can't get username.\n");
                        }
 
                        if ($server !~ /^(\d{1,3}\.){3}\d{1,3}$/) {
                                $server =~ s/\d\.]//g;
                                close(CONFIGFILE); 
-                               &fatalerror("Error in user configuration file: Invalid primary server IP address ($server)\n");
+                               fatalerror("Error in user configuration ".
+                                       "file: Invalid primary server IP ".
+                                       "address ($server)\n");
                                exit;
                        } 
                }
@@ -156,23 +147,52 @@ sub getuserinfo {
        close(CONFIGFILE);
 
        if ($user =~ /^$/) {
-               &fatalerror("User not found.\n");
+               fatalerror("User not found.\n");
        }
 
-       return ($user, $priviledge, $server);
+       return ($user, $privilege, $server);
 }
 
-$delcount=$addcount=$inprocess=0;
+#
+# Add a new AutoDNS user.
+#
+# addautodnsuser($username, $keyid, $priv, $masterip);
+# <username>:<keyid>:<privilege level>:<master server ip>
+#
+sub addautodnsuser($$$$) {
+       my $username = shift;
+       my $keyid = shift;
+       my $priv = shift;
+       my $masterip = shift;
+
+       # Create domains file for the user.
+       open (DOMAINLIST, ">>$domainlistroot$username") or
+                       fatalerror("Couldn't create domains file.\n");
+       close DOMAINLIST;
+
+       # Make the directory for the zone files.
+       my @dirs = mkpath("$zonefiledir/$username", 0, 0775);
+       fatalerror("Couldn't create zone file directory.\n")
+                       if scalar(@dirs) == 0;
+
+       # Actually add them to the users file.
+       open(USERFILE, ">> $usersfile") or
+               fatalerror("Couldn't open user configuration file.");
+       print USERFILE "$username:$keyid:$priv:$masterip\n";
+       close(USERFILE);
+}
+
+$delcount = $addcount = $inprocess = 0;
 
 # Read in the mail from stdin.
-@MAIL=<>;
+@MAIL = <>;
 
 $subject = "Reply from AutoDNS";
 # Now lets try to find out who it's from.
 foreach (@MAIL) {
        if (/^$/) { last; }
-       if (/^From: (.*)/i) { $from=$1; chomp $from;}
-       if (/^Subject:\s+(re:)?(.*)$/i) { $subject="Re: ".$2 if ($2);}
+       if (/^From: (.*)/i) { $from = $1; chomp $from;}
+       if (/^Subject:\s+(re:)?(.*)$/i) { $subject = "Re: ".$2 if ($2);}
 }
 
 if ((! defined($from)) || $from =~ /^$/ ) {
@@ -181,7 +201,7 @@ if ((! defined($from)) || $from =~ /^$/ ) {
        die "From address is mailer-daemon, ignoring.";
 }
 
-if (! defined($subject)) { $subject="Reply from AutoDNS"; };
+if (! defined($subject)) { $subject = "Reply from AutoDNS"; };
 
 # We've got a from address. Start a reply.
 
@@ -200,34 +220,107 @@ print REPLY <<EOF;
 Subject: $subject
 
 AutoDNS $VERSION
-Copyright 1999-2001 Project Purple. Written by Jonathan McDowell.
+Copyright 1999-2006 Project Purple. Written by Jonathan McDowell.
 Released under the GPL.
 
 EOF
 
 #
-# Now run GPG against our incoming mail, first making sure that our locale is
-# set to C so that we get the messages in English as we expect.
+# Throw the mail at MIME::Parser and see if it accepts it.
 #
-$ENV{'LC_ALL'}="C";
-open3(\*GPGIN, \*GPGOUT, \*GPGERR, "gpg --batch");
+my $parser = new MIME::Parser;
+$parser->output_to_core(1); # No temporary files
+my $entity = $parser->parse_data(\@MAIL);
 
-# Feed it the mail.
-print GPGIN @MAIL;
-close GPGIN;
+#
+# Make sure locale is set to C so we get messages in English as we expect.
+#
+$ENV{'LC_ALL'} = "C";
+
+if ($entity->parts) {
+       # MIME
+
+       my ($got_sig, $got_text) = (0, 0);
+       my ($sig_fh, $sig_name) = tempfile();
+       my ($text_fh, $text_name) = tempfile();
+
+       foreach my $subent ($entity->parts) {
+               if ($subent->effective_type eq "text/plain") {
+                       @COMMANDS = split /\n/,$subent->bodyhandle->as_string;
+
+                       my $str = $subent->as_string;
+                       $str =~ s/=\n$//;
+                       $str =~ s/\n/\r\n/g;
+                       print $text_fh $str;
+                       close($text_fh);
+                       $got_text++;
+               } elsif ($subent->effective_type eq
+                               "application/pgp-signature") {
+                       print $sig_fh $subent->as_string;
+                       close($sig_fh);
+                       $got_sig++;
+               } elsif ($subent->effective_type eq "multipart/mixed") {
+                       my $str = $subent->as_string;
+                       print $text_fh $str;
+                       close($text_fh);
+                       $got_text++;
+       
+                       foreach my $mixent ($subent->parts) {
+                               if ($mixent->effective_type eq "text/plain") {
+                                       push @COMMANDS, (split /\n/,
+                                               $mixent->bodyhandle->as_string);
+                               }
+                               if ($mixent->effective_type eq
+                                               "application/pgp-keys") {
+                                       push @COMMANDS, (split /\n/,
+                                               $mixent->bodyhandle->as_string);
+                               }
+                       }
+               }
+       }
 
-# And grab what it has to say.
-@GPGERROR=<GPGERR>;
-@COMMANDS=<GPGOUT>;
-close GPGERR;
-close GPGOUT;
+       if ($got_sig && $got_text) {
+               my $pid = open3(\*GPGIN, \*GPGOUT, \*GPGERR,
+                       "gpg --batch --verify ".
+                       $sig_name." ".$text_name);
+
+               close GPGIN;
+
+               @GPGERROR = <GPGERR>;
+               my @GPGOUTPUT = <GPGOUT>;
+               close GPGERR;
+               close GPGOUT;
+               waitpid $pid, 0;
+
+               unlink($text_name);
+               unlink($sig_name);
+       }
+} else {
+       # Clear text.
+
+       my $pid = open3(\*GPGIN, \*GPGOUT, \*GPGERR, "gpg --batch --verify");
+
+       # Feed it the mail.
+       print GPGIN $entity->bodyhandle->as_string;
+       close GPGIN;
+
+       # And grab what it has to say.
+       @GPGERROR = <GPGERR>;
+       @COMMANDS = <GPGOUT>;
+       @COMMANDS = split /\n/,$entity->bodyhandle->as_string;
+       close GPGERR;
+       close GPGOUT;
+       waitpid $pid, 0;
+}
 
 # Check who it's from and if the signature was a good one.
 $gpggood=1;
+my $sigtime = 0;
 foreach (@GPGERROR) {
        chomp;
-       if (/Signature made.* (.*)$/) {
-               $gpguser=$1; 
+       if (/Signature made (.*) using.*ID (.*)$/) {
+               $sigtime = str2time($1);
+               $gpguser = $2;
        } elsif (/error/) {
                $gpggood = 0;
                print REPLY "Some errors ocurred\n";
@@ -256,8 +349,23 @@ if ($gpggood) {
        exit;
 }
 
+# Check if the signature is outside our acceptable range.
+if (!defined($sigtime)) {
+       print REPLY "Couldn't parse signature time.\n";
+       close REPLY;
+       exit;
+} elsif ($sigtime > (time + $expiry)) {
+       print REPLY "Signature too far into the future.\n";
+       close REPLY;
+       exit;
+} elsif ($sigtime < (time - $expiry)) {
+       print REPLY "Signature too far into the past.\n";
+       close REPLY;
+       exit;
+}
+
 # Now let's check if we know this person.
-($user, $priv, $server) = &getuserinfo($gpguser);
+($user, $priv, $server) = getuserinfo($gpguser);
 
 if (! defined($user) || ! $user) {
        print REPLY "Unknown user.\n";
@@ -270,14 +378,21 @@ print REPLY "Got user '$user'\n";
 # Right. We know this is a valid user. Get a lock to ensure we have exclusive
 # access to the configs from here on in.
 open (LOCKFILE,">$lockfile") ||
-        &fatalerror("Couldn't open lock file\n");
-&fatalerror("Couldn't get lock\n") unless(flock(LOCKFILE,LOCK_EX));
+        fatalerror("Couldn't open lock file\n");
+fatalerror("Couldn't get lock\n") unless(flock(LOCKFILE,LOCK_EX));
 
 # Ok, now we should figure out what domains we already know about.
 foreach my $cfgfile (@cfgfiles) {
        getzones($cfgfile);
 }
 
+# Force existance of the $domainlistroot$user file
+if (! -e $domainlistroot.$user) {
+       open (DOMAINLIST, ">>$domainlistroot$user") or
+                       fatalerror("Couldn't create domains file.\n");
+       close DOMAINLIST;
+}
+
 foreach (@COMMANDS) {
        # Remove trailing CRs and leading/trailing whitespace
        chomp;
@@ -294,9 +409,9 @@ foreach (@COMMANDS) {
                # Empty line, so ignore it.
                # 
        } elsif (/^END$/) {
-               $inprocess=0;
+               $inprocess = 0;
        } elsif (/^BEGIN$/) {
-               $inprocess=1;
+               $inprocess = 1;
        } elsif ($inprocess && /^ADD\s+(.*)$/) {
                $domain = $1;
 
@@ -304,12 +419,16 @@ foreach (@COMMANDS) {
                $domain =~ tr/[A-Z]/[a-z]/;
                if (! valid_domain($domain)) {
                        $domain =~ s/[-a-z0-9.]//g;
-                       print REPLY "Invalid character(s) in domain name: $domain\n";
+                       print REPLY "Invalid character(s) in domain name:",
+                                       " $domain\n";
                } elsif (defined($zones{$domain}) && $zones{$domain}) {
                        print REPLY "We already secondary $domain\n";
                } else {
                        print REPLY "Adding domain $domain\n";
-                       $zones{$domain}=1;
+                       $zones{$domain} = 1;
+
+                       my $df = $domain;
+                       $df =~ tr,/,:,;
 
                        open (DOMAINSFILE, ">>$conffile");
                        print DOMAINSFILE "
@@ -318,14 +437,14 @@ foreach (@COMMANDS) {
 zone \"$domain\" {
        type slave;
        masters { $server; };
-       file \"secondary/$user/$domain\";
+       file \"secondary/$user/$df\";
        allow-transfer { none; };
        allow-query { any; };
 };\n";
                        close DOMAINSFILE;
 
                        open (DOMAINLIST, ">>$domainlistroot$user") or
-                               &fatalerror("Couldn't open file.\n");
+                               fatalerror("Couldn't open file.\n");
                        print DOMAINLIST "$domain\n";
                        close DOMAINLIST;
                        $addcount++;
@@ -337,40 +456,48 @@ zone \"$domain\" {
                $domain =~ tr/[A-Z]/[a-z]/;
                if (!valid_domain($domain)) {
                        $domain =~ s/[-a-z0-9.]//g;
-                       print REPLY "Invalid character(s) in domain name: $domain\n";
+                       print REPLY "Invalid character(s) in domain name:",
+                                       " $domain\n";
                } elsif (!defined($zones{$domain}) || !$zones{$domain}) {
                                print REPLY "$domain does not exist!\n";
                } else {
                        print REPLY "Deleting domain $domain\n";
-                       my (@newcfg,$found);
+                       my (@newcfg, $found);
 
                        open (DOMAINLIST, "<$domainlistroot$user") or
-                               &fatalerror("Couldn't open file $domainlistroot$user for reading: $!.\n");
+                               fatalerror("Couldn't open file ".
+                                               $domainlistroot.$user.
+                                               " for reading: $!.\n");
                        my @cfg = <DOMAINLIST>;
                        close(DOMAINLIST);
                        @newcfg = grep { ! /^$domain$/ } @cfg;
                        if (scalar @cfg == scalar @newcfg) {
-                               print REPLY "Didn't find $domain in $domainlistroot$user!\n";
-                               print REPLY "You are only allowed to delete your own domains that exist.\n";
+                               print REPLY "Didn't find $domain in ",
+                                               "$domainlistroot$user!\n";
+                               print REPLY "You are only allowed to delete",
+                                       " your own domains that exist.\n";
                                next;
                        }
 
                        open (DOMAINLIST, ">$domainlistroot$user") or 
-                               &fatalerror("Couldn't open file $domainlistroot$user for writing: $!.\n");
+                               fatalerror("Couldn't open file ".
+                                               $domainlistroot.$user.
+                                               " for writing: $!.\n");
                        print DOMAINLIST @newcfg;
                        close DOMAINLIST;
 
-                       $found=0;
-                       @newcfg=();
+                       $found = 0;
+                       @newcfg = ();
                        open (DOMAINSFILE, "<$conffile") or
-                               &fatalerror("Couldn't open file $conffile for reading: $!\n");
+                               fatalerror("Couldn't open file $conffile for".
+                                               " reading: $!\n");
                        {
                        local $/ = ''; # eat whole paragraphs
                        while (<DOMAINSFILE>) {
                                unless (/^\s*zone\s+"$domain"/) {
                                        push @newcfg, $_;
                                } else {
-                                       $found=1;
+                                       $found = 1;
                                        if ($newcfg[-1] =~ /^###/) {
                                                # remove comment and \n
                                                pop @newcfg;
@@ -380,12 +507,14 @@ zone \"$domain\" {
                        } # end of paragraph eating
 
                        if (!$found) {
-                               print REPLY "Didn't find $domain in $conffile!\n";
+                               print REPLY "Didn't find $domain in",
+                                               " $conffile!\n";
                                next;
                        }
 
                        open (DOMAINSFILE, ">$conffile") or
-                               &fatalerror("Couldn't open $conffile for writing: $!\n");
+                               fatalerror("Couldn't open $conffile for".
+                                               " writing: $!\n");
                        print DOMAINSFILE @newcfg;
                        close DOMAINSFILE;
                        $delcount++;
@@ -406,19 +535,71 @@ zone \"$domain\" {
                } else {
                        print REPLY "Couldn't open $domainlistroot$user: $!\n";
                }
+       } elsif ($inprocess && /^MASTER\s(.*)$/) {
+               if (($priv & 1) != 1) {
+                       print REPLY "You're not authorised to use the MASTER ",
+                               "command.\n";
+               } elsif ($1 =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/) {
+                       $server = $1;
+                       print REPLY "Set master IP address to $1\n";
+               } else {
+                       print REPLY "$1 doesn't look like a valid IPv4 ",
+                               "address to me.\n";
+               }
+       } elsif ($inprocess && /^ADDUSER\s(.*)$/) {
+               if (($priv & 2) != 2) {
+                       print REPLY "You're not authorised to use the ",
+                               "ADDUSER command.\n";
+               } elsif ($1 =~ /^([a-z0-9]+) ([A-Fa-f0-9]{8}) (\d+) (\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/) {
+                       addautodnsuser($1, $2, $3, $4);
+
+                       print REPLY "Attempting to import new key:\n";
+
+                       # Feed our command mail to GPG so we can pull the
+                       # (hopefully included) new GPG key out from it.
+                       my $pid = open3(\*GPGIN, \*GPGOUT, \*GPGERR,
+                                       "gpg --batch --import");
+
+                       # Feed it the mail.
+                       print GPGIN join("\n", @COMMANDS);
+                       close GPGIN;
+
+                       # And grab what it has to say.
+                       @GPGERROR = <GPGERR>;
+                       my @GPGOUTPUT = <GPGOUT>;
+                       close GPGERR;
+                       close GPGOUT;
+                       waitpid $pid, 0;
+
+                       print REPLY @GPGERROR;
+               } else {
+                       print REPLY "ADDUSER parameter error.\n";
+               }
        } elsif ($inprocess && /^HELP$/) {
-               print REPLY "In order to use the service, you will need to send GPG signed\n";
-               print REPLY "messages.\n\n";
-               print REPLY "The format of the text in these messages is important, as they represent\n";
-               print REPLY "commands to autodns. Commands are formatted one per line, and enclosed\n";
-               print REPLY "by \"BEGIN\" and \"END\" commands (without the quotes).\n";
-               print REPLY "Current valid commands are:\n";
-               print REPLY "BEGIN - begin processing.\n";
-               print REPLY "END - end processing.\n";
-               print REPLY "HELP - display this message.\n";
-               print REPLY "LIST - show all the zones currently held by you.\n";
-               print REPLY "ADD <domain> - adds the domain <domain> for processing.\n";
-               print REPLY "DEL <domain> - removes the domain <domain> if you own it.\n";
+               print REPLY <<EOF;
+In order to use the service, you will need to send GPG signed messages.
+The format of the text in these messages is important, as they represent
+commands to autodns. Commands are formatted one per line, and enclosed
+by "BEGIN" and "END" commands (without the quotes).
+
+Current valid commands are:
+
+BEGIN - begin processing.
+END - end processing.
+HELP - display this message.
+LIST - show all the zones currently held by you.
+ADD <domain> - adds the domain <domain> for processing.
+DEL <domain> - removes the domain <domain> if you own it.
+EOF
+               if (($priv & 1) == 1) {
+                       print REPLY "MASTER <ip address> - set the nameserver".
+                       " we should slave off for subsequent ADD\ncommands.\n";
+               }
+               if (($priv & 2) == 2) {
+                       print REPLY "ADDUSER <username> <keyid> <privilege> ",
+                               "<masterip> - add a new user. Imports any key",
+                               "\nattached to the message into the keyring.\n";
+               }
        } elsif ($inprocess) {
                print REPLY "Unknown command!\n";
        }