http://jeremy.kister.net/code/esec/contrib/admin.p

#!/usr/local/bin/perl

use strict;
use CGI qw(-nosticky :standard);
use CGI::Carp ('fatalsToBrowser');
use CGI::Cookie;
use Mail::vpopmail;
use Mail::VRFY;
use DBI;

my $dbun = 'db_username';
my $dbpw = 'db_password';
my $dsn = 'DBI:Sybase:server=sql.example.net;database=esec';
my @admins = qw/[e-mail] [e-mail]/;

my $q = new CGI();
my $me = $ENV{'SCRIPT_NAME'};
my $esecurl = 'http://' . $ENV{'HTTP_HOST'} . '/cgi-bin/eseccgi.pl';
my $url = 'http://' . $ENV{'HTTP_HOST'} . $me;

my %cookies = fetch CGI::Cookie;
if( ($cookies{'sess_id'} =~ /sess_id=(.+)\;/) && (my $sess_id = $1) ){
	my $dbh = DBI->connect($dsn, $dbun, $dbpw,{PrintError => 1});
	my $sql = 'SELECT emailid,email FROM accounts WHERE session_id = ' . $dbh->quote($sess_id);
	my $sth = $dbh->prepare($sql);
	$sth->execute;
	my $row=$sth->fetchrow_arrayref;
	if((my $emailid = $row->[0]) && (my $email = $row->[1])){
		print $q->header(),
				"\n",
				"\n",
				'', "\n",
				"\n";
		my $vchkpw = Mail::vpopmail->new(cache => 0, debug => 0);
		my $dir = $vchkpw->get(email => $email, field => 'dir');
		if((my $newaddr = $q->param('newaddr')) && (my $method=$q->param('method'))){
			my $newpass = $q->param('newpass');
			my $newname = $q->param('newname');
			if($newaddr =~ /[A-Z]/){
				print "lower-case, please\n";
				exit;
			}
			if($method eq 'esec'){
				die "invalid password\n" unless($newpass);
				die "invalid Real Name\n" unless($newname);
			}
			my $domain = (split(/\@/, $email))[1];
			my $fulladdr = $newaddr . '@' . $domain;
			my $res = Mail::VRFY::CheckAddress(addr => $fulladdr, method => 'syntax', debug => 0);
			if($res){
				print "$fulladdr is not a good enough looking email address.";
				exit;
			}
			if(open(FILE, ">$dir/.qmail-$newaddr")){
				if($method eq 'esec'){
					print FILE "| /usr/local/script/esec.pl $fulladdr\n";
				}else{
					print FILE "&${newaddr}\@mail.$domain\n";
				}
				close FILE;
				chmod(0600, "$dir/.qmail-$newaddr") || die "couldnt chmod $dir/.qmail-$newaddr: $!\n";
			}else{
				die "could not write to $dir/.qmail-$newaddr: $!\n";
			}
			if($method eq 'esec'){
				system('/home/vpopmail/bin/vadduser', $fulladdr, $newpass);
	
				srand(time() ^($$ + ($$ << 15)));
				my @a = grep {/[a-zA-Z0-9]/} map {chr($_)} (0..256);
				my $salt = $a[ rand( @a ) ] . $a[ rand(@a) ];
				my $crypt = crypt($newpass, $salt);
	
				my $sql = 'INSERT INTO accounts (email,crypt,name) VALUES (';
				$sql .= $dbh->quote($fulladdr) . ',' . $dbh->quote($crypt) . ',' . $dbh->quote($newname) . ')';
				my $sth = $dbh->prepare($sql);
				$sth->execute;
			}
			print '';
			exit;
		}elsif((my $addr=$q->param('addr')) && ($q->param('delete') || $q->param('convert'))){
			if($addr =~ /[A-Z]/){
				print "lower-case, please\n";
				exit;
			}
			my $domain = (split(/\@/, $email))[1];
			my $fulladdr = $addr . '@' . $domain;
			foreach my $admin (@admins){
				if($admin eq $fulladdr){
					print "will not delete administrative user\n";
					exit;
				}
			}
			open(FILE, "$dir/.qmail-$addr") || die "couldnt open $dir/.qmail-$addr: $!\n";
			chop(my $line = );
			close FILE;
			my $method = ($line =~ /esec.pl/) ? 'esec' : 'plain';
	
			if($q->param('delete')){
				if(unlink("$dir/.qmail-$addr")){
					if($method eq 'esec'){
						system('/home/vpopmail/bin/vdeluser', $fulladdr);
		
						my $sql = 'SELECT emailid FROM accounts WHERE email = ' . $dbh->quote($fulladdr);
						my $sth = $dbh->prepare($sql);
						$sth->execute;
						while(my $row = $sth->fetchrow_arrayref){ # just in case
							if(my $emailid = $row->[0]){
								foreach my $table ('accounts','messages','challenges','email_whitelists','email_blacklists','header_whitelists','header_blacklists'){
									my $sql = "DELETE FROM $table WHERE emailid = " . $dbh->quote($emailid);
									my $sth = $dbh->prepare($sql);
									$sth->execute;
								}
							}
						}
					}
					print '';
					exit;
				}else{
					print "could not delete $dir/.qmail-$addr: $!\n";
				}
			}elsif($q->param('convert')){
				# convert
				if($method eq 'esec'){
					if(open(FILE, ">${dir}/.qmail-${addr}")){
						print FILE "&${addr}\@mail.${domain}\n";
						close FILE;

						my $sql = 'SELECT emailid FROM accounts WHERE email = ' . $dbh->quote($fulladdr);
						my $sth = $dbh->prepare($sql);
						$sth->execute;
						while(my $row = $sth->fetchrow_arrayref){ # just in case
							if(my $emailid = $row->[0]){
								foreach my $table ('accounts','messages','challenges','email_whitelists','email_blacklists','header_whitelists','header_blacklists'){
									my $sql = "DELETE FROM $table WHERE emailid = " . $dbh->quote($emailid);
									my $sth = $dbh->prepare($sql);
									$sth->execute;
								}
							}
						}

						print '';
					}else{
						print "cannot write to $dir/.qmail-$addr: $!\n";
						exit;
					}
				}elsif($method eq 'plain'){
					# make into an esec account
					my ($first,$last) = $addr =~ /^(.)(.+)/;
					my $newname = "$first $last";
					my $randpass = getrand(8);
					$url .= "?newaddr=${addr}&method=esec&newpass=${randpass}&newname=${newname}";
				
					open(MAIL, "|/usr/lib/sendmail -t");
					print MAIL "To: ${fulladdr}\n",
					           "Subject: Email Secretary account\n",
					           "\n",
					           "Your Email Secretary account has been initialized.\n",
					           "You may log in at the following URL:\n",
					           "${esecurl}\n",
					           "Username: $fulladdr\n",
					           "Password: $randpass\n";
					close MAIL;
					print '';
				}else{
					die "method error: $method\n";
				}
			}else{
				die "confuzzled";
			}
		}else{
			if(opendir(DIR, $dir)){
				print '', "\n";
				foreach my $file (sort grep {/^.qmail-/} readdir DIR){
					my ($addr) = $file =~ /.qmail-(.+)/;
					next if ($addr eq 'default');
					if(open(FILE, "$dir/$file")){
						chop(my $line = );
						close FILE;
						my $method = ($line =~ /esec.pl/) ? 'esec' : 'plain';
						print $q->start_form('post',$me),
						      "\n",
						      '\n",
						      "\n",
						      $q->end_form();
					}else{
						die "could not open $dir/$file: $!\n";
					}
				}
				closedir DIR;
				print "
$addr
\n",
						      $q->hidden('addr',$addr), "\n",
						      $q->submit('delete'), "
', $q->submit('convert'), "
${method}
\n",
				      $q->start_form('post',$me),
				      "Add user: ", '', "
\n",
				      "Password: ", '', "
\n",
				      "Real Name: ", '', "
\n",
						$q->radio_group(-name=>'method',-values=>['esec','plain'],-default=>'plain'), "
\n",
				      $q->submit('Submit'), $q->end_form();
			}else{
				warn "could not open $dir: $!\n";
			}
		}
		print $q->end_html();

	}elsif((my $email=$q->param('email')) && (my $password=$q->param('password'))){
		# authenticate - user wants to manage thier stuff
		unless(grep {/^$email$/} @admins){
			print $q->header(), $q->start_html('Email Secretary'),
			      "Authentication error(0).
\n",
					'Click here to try again.
',
			      $q->end_html();
			exit;
		}
			

		my $sql = 'SELECT crypt FROM accounts WHERE email = ' . $dbh->quote($email);
		my $sth = $dbh->prepare($sql);
		$sth->execute;
		my $row=$sth->fetchrow_arrayref;
		my $crypt=$row->[0];
  
		if( ($crypt eq crypt($password, $crypt)) && defined($crypt) && defined($password) ){
			#authentcated -- save session_id and redirect back

			my $sql = 'UPDATE accounts SET session_id = ' . $dbh->quote($sess_id);
			$sql .= ' WHERE email = ' . $dbh->quote($email);
			my $sth = $dbh->prepare($sql);
			$sth->execute || die "cannot set session id to $sess_id for email $email: $!\n";
  
			print $q->header(),
			      'Redirecting..
';
		}else{
			print $q->header(), $q->start_html('Email Secretary'),
			      "Authentication error.
\n",
					'Click here to try again.
',
			      $q->end_html();
		}
	}else{
		my $cookiesid = new CGI::Cookie(-name=>'sess_id',-value=>'');
		print $q->header(-cookie=>[$cookiesid]),
			   'Redirecting..';
		exit;
	}
	$dbh->disconnect();
}else{
	my $random = getrand(64); # 512bit
	my $cookiesid = new CGI::Cookie(-name=>'sess_id',-value=>$random);
	print $q->header(-cookie=>[$cookiesid]), $q->start_html('Email Secretary'), $q->start_form('post',$me),
			"\n",
			'', "\n",
			'', "
Email Address: 
Password: 

\n",
			$q->submit('Login'), $q->end_form(), $q->end_html();
}

sub getrand {
	my $len = shift || 32;
	my($buf,$x,$random);
	open(D, '/dev/urandom') || die "cannot open urandom: $!\n";
	my @set = ('A'..'Z', 'a'..'z', '0'..'9', '_', '.');
	foreach(1..$len){
		sysread( D, $buf, 1 );
		my $v = ord($buf);
		$x ^= ($v & ~63) >> (rand(7)+1);
		$random .= $set[ ($x ^ ord($buf)) & 63 ];
	}
	close D;

	return($random);
}