eadmin.pl

#!/usr/local/bin/perl

# to manage vpopmail forwards via email
# the latest version of this code may be found at:
# 
# Jeremy Kister -  - 2007.04.15

# * subject must be formatted: [CREATE|DELETE]   
#   I.E. CREATE VerySeCreT [e-mail] [e-mail]

# Installation is simple:
#
## wget 
## tar -zxf Mail-vpopmail-0.54.tgz
## cd Mail-vpopmail-0.54
## perl Makefile.PL ; make ; make install
#
## wget 
## chmod ugo+x eadmin.pl
## echo "|/usr/local/script/eadmin.pl" > ~vpopmail/domains/example.com/.qmail-someaddress
#
# edit eadmin.pl and modify the %secrets (below).  the CRYPT can be
# made using crypt() or use 



use strict;
use Mail::vpopmail;

my %secrets = ('example.net' => 'CRYPT',
               'example.com' => 'CRYPT',
              );

my $DEBUG = 0;

my($uid,$gid) = (getpwnam('vpopmail'))[2,3];

my $subject;
my $count = 1;
while(){
	if(/^Subject\s*:\s?(.+)/i){
		$subject = $1;
		last;
	}elsif(/^\s*$/){
		last;
	}
	last if($count > 50);
	$count++;
}

my $confirmed = 0;
if($subject){
	chomp($subject);
	my($cmd,$secret,$target,$source) = split(/\s+/, $subject);
	if($cmd && $secret && $target && $source){
		warn "$cmd, $secret, $target, $source\n" if($DEBUG);
		if($source =~ /^(([a-z0-9_\.\+\-\=\?\^\#]){1,64})\@((([a-z0-9\-]){1,251}\.){1,252}[a-z0-9]{2,4})$/i){
			my ($suser,$sdomain) = ($1,$3);
			warn "source syntax pass ($suser\@$sdomain)\n" if($DEBUG);
			
			if($secrets{$sdomain} eq crypt($secret, $secrets{$sdomain})){
				warn "secret confirmed\n" if($DEBUG);
				$confirmed = 1;
				if($target =~ /^(([a-z0-9_\.\+\-\=\?\^\#]){1,64})\@((([a-z0-9\-]){1,251}\.){1,252}[a-z0-9]{2,4})$/i){
					my ($tuser,$tdomain) = ($1,$3);

					if($target eq $source){
						print "target address cannot be the same as source address\n";
					}else{
						my($dir,$maildir);
						if($cmd eq 'CREATE' || $cmd eq 'DELETE'){
							my $vchkpw = Mail::vpopmail->new(cache => 1, debug => $DEBUG);
							$dir = $vchkpw->domaininfo(domain => $sdomain, field => 'dir'); # SOURCE
							$maildir = $vchkpw->userinfo(email => $target, field => 'maildir'); # TARGET

							warn "dir: $dir - maildir: $maildir\n" if($DEBUG);
							print "COMMAND CONFIRMED: $subject\n";
						}
						if(-d $dir && -d $maildir){
							$suser =~ s/\./:/g;
							if($cmd eq 'CREATE'){
								if(-f "${dir}/.qmail-${suser}"){
									print "forward address already exists\n";
								}else{
									if(open(DOTQMAIL, ">${dir}/.qmail-${suser}")){
										print DOTQMAIL "${maildir}/Maildir/\n";
										close DOTQMAIL;
							
										if(chown($uid,$gid,"${dir}/.qmail-${suser}")){
											if(chmod(0600,"${dir}/.qmail-${suser}")){
												print "$source forwarded to $target\n";
											}else{
												print "problem with chmod: $!\n";	
											}
										}else{
											print "problem with chown: $!\n";
										}
									}else{
										print "could not open $dir/.qmail-$suser: $!\n";
									}
								}
							}elsif($cmd eq 'DELETE'){
								if(unlink("${dir}/.qmail-${suser}")){
									print "$source forward deleted\n";
								}else{
									print "could not unlink ${dir}/.qmail-$suser: $!\n";
								}
							}
						}
					}
				}
			}
		}
	}
}

if($confirmed){
	exit 100; # bounce with notes on what we did
} # else just exit quietly