#!/usr/local/bin/perl # Copyright (c) 2004-2006 by Jeremy Kister # Author: Jeremy Kister # Name: Email Secretary (ESec) # Function: Challange Response system to deter spam use strict; use CGI qw(:standard); use CGI::Carp ('fatalsToBrowser'); use CGI::Cookie; use DBI; #%%VERSION%% #%%DBUN%% #%%DBPW%% #%%DSN%% #%%HAVE_PLUGIN%% #%%HAVE_VRFY%% #%%FORWARD_HOST%% #%%AUTORESPOND%% my $q = new CGI(); my $me = $ENV{'SCRIPT_NAME'}; my $url = 'http://' . $ENV{'SERVER_NAME'} . $me; if($q->param('logout')){ my $cookie = $q->cookie(-name => 'sess_id', -value => '', -expires => '-1'); print $q->header(-cookie => [$cookie]), $q->start_html(-head=>meta({-http_equiv => 'refresh', -content => "0;URL=$url"})), $q->end_html(); exit; }elsif(my $msgid=$q->param('msgid')){ my $dbh = DBI->connect($dsn, $dbun, $dbpw,{PrintError => 1}); my $sql = 'SELECT sender,emailid FROM messages WHERE msgid = ' . $dbh->quote($msgid); my $sth = $dbh->prepare($sql); $sth->execute; my $row=$sth->fetchrow_arrayref; $sth->finish; my $sender=$row->[0]; my $emailid=$row->[1]; unless(defined($sender) && defined($emailid)){ print $q->header(), $q->start_html('Email Secretary'), "Sorry, I have no Pending message matching your request.\n", $q->end_html(); exit; } $sql = 'SELECT email,name,mode FROM accounts WHERE emailid = ' . $dbh->quote($emailid); $sth = $dbh->prepare($sql); $sth->execute; $row=$sth->fetchrow_arrayref; $sth->finish; my $email = $row->[0]; my $name = $row->[1]; my $mode = $row->[2]; print $q->header(), "\n", '', "\n", "\n"; # high sec mode requires challenge/response before authenticating if($mode == 3){ if((my $qid=$q->param('qid')) && (my $response=$q->param('response')) && $q->param('Give Answer')){ # check if answer is correct my $sql = 'SELECT answer FROM challenges WHERE qid = ' . $dbh->quote($qid); my $sth = $dbh->prepare($sql); $sth->execute; my $row=$sth->fetchrow_arrayref; my $answer = $row->[0]; if($answer =~ /^\Q${response}\E$/i){ my $sql = 'SELECT verified FROM accounts WHERE emailid = '; $sql .= $dbh->quote($emailid); my $sth = $dbh->prepare($sql); $sth->execute; my $row=$sth->fetchrow_arrayref; my $verified = $row->[0]; unless(defined($verified)){ my $sql = 'SELECT verified FROM defaults'; my $sth = $dbh->prepare($sql); $sth->execute; my $row = $sth->fetchrow_arrayref; $verified = $row->[0]; } $verified =~ s/%%name%%/$name/g; move_files($dbh,$q,$email,$sender,$emailid); if(defined($verified)){ print "$verified"; }else{ print "address verified\n"; warn "could not select default or specific verified message for emailid $emailid\n"; } }else{ print "The answer you gave is not the same as what I have on record.. please try again.
\n", "perhaps re-wording your answer will help.
\n", 'click here to try again.', "
\n"; } print $q->end_html(); exit; }else{ my $sql = 'SELECT COUNT(*) FROM challenges WHERE emailid = ' . $dbh->quote($emailid); my $sth = $dbh->prepare($sql); $sth->execute; my $row=$sth->fetchrow_arrayref; my $count = $row->[0]; my $select = $emailid; unless($count > 0){ my $sql = 'SELECT COUNT(*) FROM challenges WHERE emailid = 0'; my $sth = $dbh->prepare($sql); $sth->execute; my $row=$sth->fetchrow_arrayref; $count = $row->[0]; $select = 0; } my $rand = sprintf "%.F", (rand(($count-1)) + 1); # dont want it to come back with 0 # if they didnt know the old question, dont give them the same one right away if(my $oldqid=$q->param('qid')){ if($q->param('I Dont Know') && ($qid == $oldqid)){ until($rand != $oldqid){ sleep 1; # rand based off time $rand = sprintf "%.F", (rand(($count-1)) + 1); # dont want it to come back with 0 } } } $sql = 'SELECT question,qid FROM challenges WHERE emailid = ' . $dbh->quote($select); $sth = $dbh->prepare($sql); $sth->execute; my $n=1; my ($question,$qid); while(my $row=$sth->fetchrow_arrayref){ if($n == $rand){ $question = $row->[0]; $qid = $row->[1]; last; }else{ $n++; } } print "To verify you are a not an evil spammer, please answer the following question:
\n", "${question}
\n", $q->start_form('post','%%CGI_URL%%'), "\n", '', "\n", $q->hidden('msgid',$msgid), "\n", '', "\n", '', "\n", $q->submit('Give Answer'), $q->submit('I Dont Know'), $q->end_form(); } print $q->end_html(); exit; }else{ my $sql = 'SELECT verified FROM accounts WHERE emailid = '; $sql .= $dbh->quote($emailid); my $sth = $dbh->prepare($sql); $sth->execute; my $row=$sth->fetchrow_arrayref; my $verified = $row->[0]; unless(defined($verified)){ my $sql = 'SELECT verified FROM defaults'; my $sth = $dbh->prepare($sql); $sth->execute; my $row = $sth->fetchrow_arrayref; $sth->finish; $verified = $row->[0]; } $verified =~ s/%%name%%/$name/g; move_files($dbh,$q,$email,$sender,$emailid); if(defined($verified)){ print "$verified"; }else{ print "address verified\n"; warn "could not select default or specific verified message for emailid $emailid\n"; } print $q->end_html(); exit; } }else{ # management console 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,name 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 $name = $row->[2]) && (my $email = $row->[1])){ my($user,$domain) = split(/\@/, $email); # we dont support routing data print $q->header(), #$q->start_html('ESec Management Console'), "\n", "ESec Management Console\n", '', "\n", "\n", "

ESec Management Console

\n", 'Home
', "\n", 'View Pending Messages
', "\n", 'Modify Your ESec Account
', "\n", 'Logout

', "\n"; if($q->param('Submit') eq 'Process Checkboxes'){ my $maildir = get_maildir($email); # guaranteed my %processed; foreach my $file ($q->param('whitelist')){ my $sql = 'SELECT sender FROM messages WHERE filename = ' . $dbh->quote($file); my $sth = $dbh->prepare($sql); $sth->execute; my $row = $sth->fetchrow_arrayref; if(my $sender = $row->[0]){ unless($processed{$sender}){ move_files($dbh,$q,$email,$sender,$emailid,$maildir); print "${sender} added to email whitelist, applicable messages moved.
\n"; $processed{$sender} = 1; } } } foreach my $file ($q->param('move')){ my $moved; if($forward_host){ if(open(F, "${maildir}/pnd/${file}")){ open(SENDMAIL, "|/var/qmail/bin/sendmail ${user}\@${forward_host}") || die "cannot fork sendmail: $!\n"; while(){ print SENDMAIL; } close SENDMAIL; close F; unlink("${maildir}/pnd/${file}") || die "could not unlink ${maildir}/pnd/${file}: $!\n"; $moved=1; }else{ print "couldnt transfer file ${maildir}/pnd/${file}: $!\n"; } }else{ if(rename("${maildir}/pnd/${file}","${maildir}/new/${file}")){ $moved=1; print "Message is now ready to be transferred.
\n"; }else{ print "couldnt rename file ${maildir}/pnd/${file}: $!\n"; } } if($moved){ my $sql = 'DELETE FROM messages WHERE emailid = ' . $dbh->quote($emailid); $sql .= ' AND filename = ' . $dbh->quote($file); my $sth = $dbh->prepare($sql); $sth->execute || print "cannot remove $file from db: $!\n"; } } foreach my $file ($q->param('delete')){ if(unlink("${maildir}/pnd/${file}")){ my $sql = 'DELETE FROM messages WHERE emailid = ' . $dbh->quote($emailid); $sql .= ' AND filename = ' . $dbh->quote($file); my $sth = $dbh->prepare($sql); $sth->execute || print "cannot remove $file from db: $!\n"; print "deleted $file
\n"; }else{ print "cannot remove $file: $!\n"; } } print 'Click here to continue.', "
\n"; }elsif(($q->param('Submit') eq 'Delete All') && ($q->param('confirm') eq 'Im sure')){ my $maildir = get_maildir($email); # one at a time, for consitency (think new incoming messages) my $sql = 'SELECT filename FROM messages WHERE emailid = ' . $dbh->quote($emailid); my $sth = $dbh->prepare($sql); $sth->execute; while(my $row=$sth->fetchrow_arrayref){ my $file = $row->[0]; if(unlink("${maildir}/pnd/${file}")){ my $sqla = 'DELETE FROM messages WHERE emailid = ' . $dbh->quote($emailid); $sqla .= ' AND filename = ' . $dbh->quote($file); my $stha = $dbh->prepare($sqla); $stha->execute || warn "could not delete $file from db: $!\n"; }else{ warn "could not delete $file: $!\n"; } } print 'Please wait...', ''; exit; }elsif(my $sort=$q->param('showpnd')){ my $pnddir = get_maildir($email) . "/pnd"; if(my $file=$q->param('pndfile')){ die if(($file !~ /^\d+\.\d+\.[A-Za-z0-9\_]{4}\.esec\./) || ($file =~ /\.\./)); if(open(F, "${pnddir}/${file}")){ print "
\n";
						while(){
							s/>/\>/g;
							s/\n";
					}else{
						print "sorry, I cant find that message; perhaps it was just confirmed..\n";
					}
				}else{
					print "Pending Messages:
\n",
					      $q->start_form('post',"%%CGI_URL%%"), "\n",
					      $q->hidden('showpnd',$q->param('showpnd')), "\n",
					      $q->submit('Submit','Process Checkboxes'),
					      '',
					      ' \n",
						  ' \n";

					if($HAVE_PLUGIN){
						my $spam;
					   print ' \n";
					}

					if($HAVE_VRFY){
						my $vrfy;
						print ' \n";
					}

					print ' \n",
					      " \n",
						  " \n",
						  " \n",
						  "\n";
					opendir(D, $pnddir) || die "cannot opendir $pnddir: $! 
\n",
 					 "If ESec hasnt received mail for this account yet, this message is normal.\n";
					#my(%from,%subject,%received,%html);
					my %data;
					foreach my $file (grep {!/^\./} readdir D){
						my %msg;
						my $from;
						open(F, "${pnddir}/${file}") || die "cannot open file $pnddir/$file: $!\n";
						my $line = 0;
						my $pos = 0;
						while(){
							$line++;
							$pos += length($_); # must keep track of position for seek below
							last if((/^$/) || ($line > 100) ||
								     (exists($msg{'received'}) && exists($msg{'from'}) && exists($msg{'subject'})));
							if(/^X-ESec-Received:\s(.+)/){
								$msg{'received'} = $1;
							}elsif(/^Return-Path:\s\<(.{0,27})(.*)\>/i){ # we whitelist/blacklist based on envelope
								$msg{'from'} = $1;
								$from = $1 . $2;
								if(length($2) > 3){
									$msg{'from'} .= '...';
								}elsif($2){
									$msg{'from'} .= $2;
								}
							}elsif(/^subject\s*:\s(.{0,27})(.*)/i){
								$msg{'subject'} = $1;
								if(length($2) > 3){
									$msg{'subject'} .= '...';
								}elsif($2){
									$msg{'subject'} .= $2;
								}
							}elsif(($HAVE_VRFY || $HAVE_PLUGIN) && /^X-ESec-Notes:\s(.+)/i){
								my $num=1; # we count the note above as #1
								my %note;
								$note{$num} = $1;
								while(){
									if(/^\s/){
										# another esec note
										$num++;
										$note{$num} = $_;
									}else{
										# must rewind F to be previous line
										seek(F,$pos,0);
										last;
									}
								}
								foreach my $value (values %note){
									if($value =~ /Did not send/){
										if($value =~ /Mail::VRFY/){
											#bad email addr
											$msg{'vrfy'} = 1; # RED
										}else{
											# plugin says spam
											$msg{'spam'} = 1; # RED
										}
									}
								}
							}
						}
						close F;
						foreach my $key (keys %msg){
							$msg{$key} =~ s/>/\>/g;
							$msg{$key} =~ s/start_form('post','%%CGI_URL%%'), "\n",
						   	   " \n",
						   	   " \n";
							if($HAVE_PLUGIN){
								print '' . "\n";
	
							}
							if($HAVE_VRFY){
								print '' . "\n";
							}
							print " \n",
						   	   " ', "\n",
							      ' ', "\n",
							      ' ', "\n",
						   	   "\n";
						}else{
							$data{vrfy}{$file} = $msg{'vrfy'};
							$data{spam}{$file} = $msg{'spam'};
							my $vrfy_image = ($msg{'vrfy'} == 1) ? 'red' : 'green';
							my $spam_image = ($msg{'spam'} == 1) ? 'red' : 'green';
							$data{from}{$file} = $msg{'from'};
							$data{subject}{$file} = $msg{'subject'};
							$data{received}{$file} = $msg{'received'};
							$data{html}{$file} = "\n" .
						   	   " \n" .
						   	   " \n" .
							      ' ' . "\n" .
							      ' ' . "\n" .
						   	   " \n" .
						   	   " ' . "\n" .
							      ' ' . "\n" .
							      ' ' . "\n" .
						   	   "\n";
						}
					}
					closedir D;
					unless($sort == 1){
						my @sorted;
						if($sort eq 'received'){
                     my %m = (Jan => 1, Feb => 2, Mar => 3, Apr => 4, May => 5, Jun => 6,
                              Jul => 7, Aug => 8, Sep => 9, Oct => 10, Nov => 11, Dec => 12);
							@sorted = map { $_->[1] }
							 sort { $a->[3] <=> $b->[3] ||
							        $m{$a->[2]} <=> $m{$b->[2]} ||
							        $a->[1] <=> $b->[1] ||
							        $a->[4] cmp $b->[4] }
							 map { [ $data{$sort}{$_}, $_ ] }
							 keys %{$data{$sort}};
						}else{
							@sorted = map { $_->[1] }
							 sort { lc($a->[0]) cmp lc($b->[0])
							     || lc($a->[0]) <=> lc($b->[0]) }
							 map { [ $data{$sort}{$_}, $_ ] }
							 keys %{$data{$sort}};
						}
						my @ready = ($q->param('reverse')) ? (reverse @sorted) : @sorted;
						foreach my $file (@ready){
							print "$data{html}{$file}";
						}
					}
					print "
From', "${f}Subject', "${s}spam', "${spam}VRFY', "${vrfy}Received', "${r}
Whitelist User
and Move
Move to Inbox
Delete
$msg{'from'}$msg{'subject'}$msg{'received'}
", $q->hidden('filename',${file}), "\n",
							      $q->hidden('sender',${from}), "\n",
							      '
$msg{'from'}$msg{'subject'}$msg{'received'}
" . $q->hidden('filename',${file}) . "\n" .
                           $q->hidden('sort',$sort) . "\n";
							if($q->param('reverse')){
 									$data{html}{$file} .= $q->hidden('reverse',1) . "\n";
							}
							$data{html}{$file} .= $q->hidden('sender',${from}) . "\n" .
							      '
\n",
					      $q->submit('Submit','Process Checkboxes'),
					      $q->end_form(),
					      $q->start_form('post','%%CGI_URL%%'),
					      $q->submit('Submit','Delete All'), "\n",
					      $q->popup_menu(-name=>'confirm',
					                 -values=>['Im sure',''],
						             -default=>''), "\n",
					      $q->end_form(), "
\n";
					pfooter('back');
				}
			}elsif(my $modify=$q->param('modify')){
				my $link = "%%CGI_URL%%?modify=$modify";
				if($modify eq 'esec_messages'){
						my $sql = 'SELECT mode,message,reply_blurb,verified FROM accounts WHERE emailid = ' . $dbh->quote($emailid);
						my $sth = $dbh->prepare($sql);
						$sth->execute;
						my $row = $sth->fetchrow_arrayref;
						my $mode = $row->[0];
						my $message = $row->[1];
						my $reply_blurb = $row->[2] if($mode == 1);
						my $verified = $row->[3];

						$sql = 'SELECT message,reply_blurb,verified FROM defaults';
						$sth = $dbh->prepare($sql);
						$sth->execute;
						$row = $sth->fetchrow_arrayref;
						$sth->finish;
						my $default_message = $row->[0];
						my $default_verified = $row->[2];
						my $default_reply_blurb = $row->[1] if($mode == 1);

						$default_message =~ s/\n/
\n/g;
						#$default_verified =~ s/\n/
\n/g; # dont need default_verified changed
						# reply blurb is converted below..

						my $maildir = get_maildir($email); # guaranteed
						if($autorespond){
							my $vacation;
							if(open(F, "${maildir}/../vacation/message")){
								my $flag;
								while(){
									if(/^$/){
										$flag=1;
										next;
									}
									next unless($flag);
									$vacation .= $_;
								}
								close F;
							}
							my $active = (-f "${maildir}/../vacation/active") ? 1 : 0;
	
							print $q->start_form('post',"%%CGI_URL%%"), "Your away message: 

\n",
							      '\n",
							      '

', "\n",
								   'On  ', "\n",
								   'Off
', "\n",
							      $q->submit('Submit','Save'), " ", $q->submit('Submit','Delete'), $q->end_form(), "
\n",
							      "
\n
\n";
						}
						print "Key:
\n",
						      "%%name%% will be replaced with your real name
\n",
					         "%%msgid%% will be replaced with the message id
\n",
						      "%%subject%% will be replaced with the subject of the original message

\n",

						      $q->start_form('post',"%%CGI_URL%%"), "Your custom probe message: 

\n",
						      '\n",
						      '

', "\n",
						      $q->submit('Submit','Save'), " ", $q->submit('Submit','Delete'), $q->end_form(), "
\n",
						      "The default probe message for this installation is:
\n",
					        "${default_message}
\n",
						      "
\n
\n",

					        $q->start_form('post',"%%CGI_URL%%"), "Your custom verified message: 

\n",
						      '\n",
						      '

', "\n",
						      $q->submit('Submit','Save'), " ", $q->submit('Submit','Delete'), $q->end_form(), "
\n",
						      "The default verified message for this installation is:
\n",
					          "${default_verified}
\n";

						if($mode == 1){
							$default_reply_blurb =~ s/\n/
\n/g;
							print "
\n
\n",
							      $q->start_form('post',"%%CGI_URL%%"), "Your custom reply blurb: 

\n",
						      '\n",
						      #$q->hidden('modify','reply_blurb'), "

\n", # STUPID CGI!
						      '

', "\n",
						      $q->submit('Submit','Save'), " ", $q->submit('Submit','Delete'), $q->end_form(), "
\n",
						      "The default reply_blurb for this installation is:
\n",
					          "${default_reply_blurb}
\n";
						}
				}elsif($modify eq 'vacation'){
					my $maildir = get_maildir($email); # guaranteed
					if(my $status = $q->param('status')){
						if($q->param('Submit') eq 'Delete'){
							if($status eq 'Off'){
								unlink("${maildir}/../vacation/message") || die "cannot remove message: $!\n";
							}else{
								print "ERROR: will not delete away message while away is On\n";	
								exit;
							}
						}elsif(($q->param('Submit') eq 'Save') && (my $vacation=$q->param('vacation'))){
							unless(-d "${maildir}/../vacation/"){
								mkdir("${maildir}/../vacation/",0700) || die "cannot mkdir vacation: $!\n";
							}
							$vacation =~ s/\r\n/\n/g;
							open(F, ">${maildir}/../vacation/message") || die "cannot write to message: $!\n";
							print F "Subject: Auto: Away Autoresponse\n",
							        "From: \"${name}\" <${email}>\n",
							        "\n",
							        "$vacation\n";
							close F;
						}elsif($q->param('Submit') eq 'Save'){
							die "will not save a blank away message\n";
						}else{
							die "confused\n";
						}
						if($status eq 'On'){
							unless(-f "${maildir}/../vacation/active"){
								open(F, ">${maildir}/../vacation/active") || die "cannot write to active: $!\n";
								close F;
							}
						}else{
							if(-f "${maildir}/../vacation/active"){
								unlink("${maildir}/../vacation/active") || die "cannot unlink active: $!\n";
							}
						}
	
						print 'Please wait...',
						      '';
					}else{
						die "you didnt choose On or Off\n";
					}
				}elsif($modify eq 'message'){
					if($q->param('Submit') eq 'Delete'){
						my $sql = 'UPDATE accounts SET message = NULL WHERE emailid = ' . $dbh->quote($emailid);
						my $sth = $dbh->prepare($sql);
						$sth->execute || die "cannot update accounts: $!\n";
					}elsif(($q->param('Submit') eq 'Save') && (my $message=$q->param('message'))){
						my $sql = 'UPDATE accounts SET message = ' . $dbh->quote($message);
						$sql .= ' WHERE emailid = ' . $dbh->quote($emailid);
						my $sth = $dbh->prepare($sql);
						$sth->execute || die "cannot update accounts: $!\n";
					}else{
						die "confused\n";
					}
					print 'Please wait...',
					      '';
				}elsif($modify eq 'verified'){
					if($q->param('Submit') eq 'Delete'){
						my $sql = 'UPDATE accounts SET verified = NULL WHERE emailid = ' . $dbh->quote($emailid);
						my $sth = $dbh->prepare($sql);
						$sth->execute || die "cannot update accounts: $!\n";
					}elsif(($q->param('Submit') eq 'Save') && (my $verified=$q->param('verified'))){
						my $sql = 'UPDATE accounts SET verified = ' . $dbh->quote($verified);
						$sql .= ' WHERE emailid = ' . $dbh->quote($emailid);
						my $sth = $dbh->prepare($sql);
						$sth->execute || die "cannot update accounts: $!\n";
					}else{
						die "confused\n";
					}
					print 'Please wait...',
					      '';
				}elsif($modify eq 'reply_blurb'){
					if($q->param('Submit') eq 'Delete'){
						my $sql = 'UPDATE accounts SET reply_blurb = NULL WHERE emailid = ' . $dbh->quote($emailid);
						my $sth = $dbh->prepare($sql);
						$sth->execute || die "cannot update accounts: $!\n";
					}elsif(($q->param('Submit') eq 'Save') && (my $reply_blurb=$q->param('reply_blurb'))){
						my $sql = 'UPDATE accounts SET reply_blurb = ' . $dbh->quote($reply_blurb);
						$sql .= ' WHERE emailid = ' . $dbh->quote($emailid);
						my $sth = $dbh->prepare($sql);
						$sth->execute || die "cannot update accounts: $!\n";
					}else{
						die "confused\n";
					}
					print 'Please wait...',
					      '';
				}elsif($modify eq 'email_whitelist'){
					if(my @addrs = split(/\r?\n/, $q->param('new_whitelist'))){
						my $dupe;
						foreach my $new (@addrs){
							my $sql = 'SELECT COUNT(*) FROM email_whitelists WHERE addr = ' . $dbh->quote($new);
							$sql .= ' AND emailid = ' . $dbh->quote($emailid);
							my $sth = $dbh->prepare($sql);
							$sth->execute;
							my $row = $sth->fetchrow_arrayref;
							my $count = $row->[0];
							if($count == 0){
								my $sql = 'INSERT INTO email_whitelists (emailid,addr) VALUES (';
								$sql .= $dbh->quote($emailid) . ',' . $dbh->quote($new) . ')';
								my $sth = $dbh->prepare($sql);
								$sth->execute || warn "couldnt add $new to database: $!\n";
								print 'Please wait...',
								      '', $q->end_html();
							}else{
								print "It appears $new is already in your whitelist.
\n";
								$dupe=1;
							}
						}
						if(defined($dupe)){
							print 'click here to continue.', "
\n";
						}
					}elsif($q->param('Upload') && (my $wholefile=$q->param('file'))){
						my $filename = $wholefile;
						$filename =~ s#.*[\\\/]##g;
						my $fh=$q->upload('file');
						if($fh){
							my ($buffer,$bigline);
							while(read($fh,$buffer,1024)){
								$bigline .= $buffer;
							}

							while($bigline =~ /(([a-z0-9_\.\+\-\=\?\^])+\@(([a-z0-9\-])+\.)+([a-z0-9]{2,4})+)/i){
								my $addr=$1;
								$bigline =~ s/\Q${addr}//;
								my $sql = 'SELECT COUNT(*) FROM email_whitelists WHERE addr = ' . $dbh->quote($addr);
								$sql .= ' AND emailid = ' . $dbh->quote($emailid);
								my $sth = $dbh->prepare($sql);
								$sth->execute;
								my $row = $sth->fetchrow_arrayref;
								my $count = $row->[0];
								if($count == 0){
									print "adding email addr: ${addr}
\n";
									my $sql = 'INSERT INTO email_whitelists (emailid,addr) VALUES (';
									$sql .= $dbh->quote($emailid) . ',' . $dbh->quote($addr) . ')';
									my $sth = $dbh->prepare($sql);
									$sth->execute || warn "couldnt add $addr to database: $!\n";
								}else{
									print "${addr} already seems to be in your email whitelist; skipping...
\n";
								}
							}
							print '
click here to continue.', $q->end_html();
						}else{
							print STDERR "ESec: $ENV{'REMOTE_ADDR'}: ", $q->cgi_error();
							exit 1;
						}
					}elsif((my $id=$q->param('id')) && $q->param('Delete')){
						if($id =~ /^\d+$/){
							my $sql = 'DELETE FROM email_whitelists WHERE emailid = ' . $dbh->quote($emailid);
							$sql .= ' AND id = ' . $dbh->quote($id);
							my $sth = $dbh->prepare($sql);
							$sth->execute;

							print 'Please wait...',
							      '', $q->end_html();
						}else{
							die "confused on delete email_whitelist (${id})\n";
						}
					}else{
						print "modifing email whitelist
\n",
						      $q->start_form(), $q->hidden('modify',$modify),
						      'New Email Address(es) to Whitelist:
',
						      '(one per line)
',
						      '
',
						      $q->submit('Create'), $q->end_form(), "\n",
						      $q->start_multipart_form(), $q->hidden('modify',$modify),
						      'File containing email addresses:
',
						      $q->filefield(-name=>'file',
						                -default=>'starting value',
						                -size=>50,
						                -maxlength=>80),
						      $q->submit('Upload'), $q->end_form(), "\n",
						      '', "\n";
						my $sql = "SELECT id,addr FROM email_whitelists WHERE emailid = " . $dbh->quote($emailid);
						$sql .= " ORDER BY addr";
						my $sth = $dbh->prepare($sql);
						$sth->execute;
						while(my $row=$sth->fetchrow_arrayref){
								my $id=$row->[0];
								my $addr=lc($row->[1]);
								print $q->start_form(), "", $q->end_form(), "\n";
						}
						print "
", $q->hidden('id',$id), $q->hidden('modify',$modify),
								      $q->hidden('Delete','Delete'),
								      "$addr", $q->submit('Delete'), "

\n",
						      "Common Regexp Key:\n",
                              '', "\n",
                              "\n",
                              "\n",
                              "\n",
                              "\n",
                              "\n",
                              "\n",
                              "
.Any Character
\\sWhitespace (space or tab)
*Any amount of ocurrances
?Zero or one ocurrances
+One or more ocurrances
\\Next Character escaped (litteral meaning)

\n";
						pfooter('back');
					}
				}elsif($modify eq 'email_blacklist'){
					if(my $new=$q->param('new_blacklist')){
						my $sql = 'SELECT COUNT(*) FROM email_blacklists WHERE addr = ' . $dbh->quote($new);
						$sql .= ' AND emailid = ' . $dbh->quote($emailid);
						my $sth = $dbh->prepare($sql);
						$sth->execute;
						my $row = $sth->fetchrow_arrayref;
						my $count = $row->[0];
						if($count == 0){
							my $sql = 'INSERT INTO email_blacklists (emailid,addr) VALUES (';
							$sql .= $dbh->quote($emailid) . ',' . $dbh->quote($new) . ')';
							my $sth = $dbh->prepare($sql);
							$sth->execute;

							print 'Please wait...',
							      '', $q->end_html();
						}else{
							print "It appears $new is already in your blacklist.
\n",
							      'click here to continue.', "
\n";

						}
					}elsif((my $id=$q->param('id')) && $q->param('Delete')){
						if($id =~ /^\d+$/){
							my $sql = 'DELETE FROM email_blacklists WHERE emailid = ' . $dbh->quote($emailid);
							$sql .= ' AND id = ' . $dbh->quote($id);
							my $sth = $dbh->prepare($sql);
							$sth->execute;

							print 'Please wait...',
							      '', $q->end_html();
						}else{
							die "confused on delete email_blacklists (${id})\n";
						}
					}else{
						print "modifing email blacklist
\n",
						      $q->start_form(), $q->hidden('modify',$modify),
						      'New Email Address to Blacklist: 
',
						      $q->submit('Create'), $q->end_form(), "\n",
						      '', "\n";
						my $sql = 'SELECT id,addr FROM email_blacklists WHERE emailid = ' . $dbh->quote($emailid);
						$sql .= ' ORDER BY addr';
						my $sth = $dbh->prepare($sql);
						$sth->execute;
						while(my $row=$sth->fetchrow_arrayref){
							my $id=$row->[0];
							my $addr=lc($row->[1]);
							print $q->start_form(), "", $q->end_form(), "\n";
						}
						print "
", $q->hidden('id',$id), $q->hidden('modify',$modify),
							      $q->hidden('Delete','Delete'),
							      "$addr", $q->submit('Delete'), "

\n",
							  "Common Regexp Key:\n",
                              '', "\n",
                              "\n",
                              "\n",
                              "\n",
                              "\n",
                              "\n",
                              "\n",
                              "
.Any Character
\\sWhitespace (space or tab)
*Any amount of ocurrances
?Zero or one ocurrances
+One or more ocurrances
\\Next Character escaped (litteral meaning)

\n";
						pfooter('back');
					}
				}elsif($modify eq 'header_whitelist'){
					if(my @newfields = split(/\r?\n/, $q->param('new_whitelist'))){
						my $dupe;
						foreach my $new (@newfields){
							my $sql = 'SELECT COUNT(*) FROM header_whitelists WHERE field = ' . $dbh->quote($new);
							$sql .= ' AND emailid = ' . $dbh->quote($emailid);
							my $sth = $dbh->prepare($sql);
							$sth->execute;
							my $row = $sth->fetchrow_arrayref;
							my $count = $row->[0];
							if($count == 0){
								my $sql = 'INSERT INTO header_whitelists (emailid,field) VALUES (';
								$sql .= $dbh->quote($emailid) . ',' . $dbh->quote($new) . ')';
								my $sth = $dbh->prepare($sql);
								$sth->execute;
								print 'Please wait...',
								      '', $q->end_html();
							}else{
								print "It appears $new is already in your whitelist.
\n";
								$dupe=1;
							}
						}
						if(defined($dupe)){
							print 'click here to continue.', "
\n";
						}
					}elsif((my $id=$q->param('id')) && $q->param('Delete')){
						if($id =~ /^\d+$/){
							my $sql = 'DELETE FROM header_whitelists WHERE emailid = ' . $dbh->quote($emailid);
							$sql .= ' AND id = ' . $dbh->quote($id);
							my $sth = $dbh->prepare($sql);
							$sth->execute;

							print 'Please wait...',
							      '', $q->end_html();
						}else{
							die "confused on delete header_whitelists (${id})\n";
						}
					}else{
						print "modifing header whitelist
\n",
						      $q->start_form(), $q->hidden('modify',$modify),
						      'New Header Field(s) to Whitelist: ',
						      '
',
						      $q->submit('Create'), $q->end_form(), "\n",
						      '', "\n";
						my $sql = 'SELECT id,field FROM header_whitelists WHERE emailid = ' . $dbh->quote($emailid);
						$sql .= ' ORDER BY field';
						my $sth = $dbh->prepare($sql);
						$sth->execute;
						while(my $row=$sth->fetchrow_arrayref){
								my $id=$row->[0];
								my $field=$row->[1];
								$field =~ s//>/g;
								$field =~ s/"/"/g;
								print $q->start_form(), "", $q->end_form(), "\n";
						}
						print "
", $q->hidden('id',$id), $q->hidden('modify',$modify),
								      $q->hidden('Delete','Delete'),
								      "$field", $q->submit('Delete'), "

\n";
						pfooter('back');
					}
				}elsif($modify eq 'header_blacklist'){
					if(my @fields = split(/\r?\n/, $q->param('new_blacklist'))){
						my $dupe;
						foreach my $new (@fields){
							my $sql = 'SELECT COUNT(*) FROM header_blacklists WHERE field = ' . $dbh->quote($new);
							$sql .= ' AND emailid = ' . $dbh->quote($emailid);
							my $sth = $dbh->prepare($sql);
							$sth->execute;
							my $row = $sth->fetchrow_arrayref;
							my $count = $row->[0];
							if($count == 0){
								my $sql = 'INSERT INTO header_blacklists (emailid,field) VALUES (';
								$sql .= $dbh->quote($emailid) . ',' . $dbh->quote($new) . ')';
								my $sth = $dbh->prepare($sql);
								$sth->execute;
	
								print 'Please wait...',
								      '', $q->end_html();
							}else{
								print "It appears $new is already in your blacklist.
\n";
								$dupe=1;
							}
						}
						if(defined($dupe)){
							print 'click here to continue.', "
\n";
						}
					}elsif((my $id=$q->param('id')) && $q->param('Delete')){
						if($id =~ /^\d+$/){
							my $sql = 'DELETE FROM header_blacklists WHERE emailid = ' . $dbh->quote($emailid);
							$sql .= ' AND id = ' . $dbh->quote($id);
							my $sth = $dbh->prepare($sql);
							$sth->execute;

							print 'Please wait...',
							      '', $q->end_html();
						}else{
							die "confused on delete header_blacklists (${id})\n";
						}
					}else{
						print "modifing header blacklist
\n",
						      $q->start_form(), $q->hidden('modify',$modify),
						      'New Field(s) to Blacklist: ',
						      '
',
						      $q->submit('Create'), $q->end_form(), "\n",
						      '', "\n";
						my $sql = 'SELECT id,field FROM header_blacklists WHERE emailid = ' . $dbh->quote($emailid);
						$sql .= ' ORDER BY field';
						my $sth = $dbh->prepare($sql);
						$sth->execute;
						while(my $row=$sth->fetchrow_arrayref){
								my $id = $row->[0];
								my $field = $row->[1];
								$field =~ s//\>/g;
								$field =~ s/&/\&/g;
								print $q->start_form(), "", $q->end_form(), "\n";
						}
						print "
", $q->hidden('id',$id), $q->hidden('modify',$modify),
								      $q->hidden('Delete','Delete'),
								      "$field", $q->submit('Delete'), "

\n";
						pfooter('back');
					}
				}else{
					print 'Please wait...',
					      '';
				}
				print $q->end_html();
			}else{
				my $unique = 0;
				my $sql = 'SELECT COUNT(*) FROM messages WHERE emailid = ' . $dbh->quote($emailid);
				my $sth = $dbh->prepare($sql);
				$sth->execute;
				my $row = $sth->fetchrow_arrayref;
				my $messages = $row->[0];
				if($messages > 0){
					my %senders;
					my $sql = 'SELECT sender FROM messages WHERE emailid = ' . $dbh->quote($emailid);
					my $sth = $dbh->prepare($sql);
					$sth->execute;
					while(my $row=$sth->fetchrow_arrayref){
						$senders{lc($row->[0])} = 1;
					}
					while(my $key = each %senders){
						$unique++;
					}
				}
				print "You have ${messages} waiting messages in your pending queue by ${unique} unique senders.

\n",
				      '', "\n",
				      '',
				      '', "\n",
				      "\n";	
				foreach my $list ('white','black'){
					print '\n";
				}
				print "\n",
				      "\n",
				      "\n",
				      '', "\n",
				      '', "\n",
				      '\n",
				      "
Email Whitelists [',
				       'Edit]
Email Blacklists [',
				       'Edit]
  
Header Field Whitelists [',
				       'Edit]
Header Field Blacklists [',
				       'Edit]

\n";
				pfooter();
			}
		}elsif((my $email=$q->param('email')) && (my $password=$q->param('password'))){
			# authenticate - user wants to manage thier stuff
			
			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];
	
			print $q->header(), $q->start_html('Email Secretary');
			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 'Please wait...',
				      '';
			}else{
				print "Authentication error.
\n",
				      'Click here to try again.
';
			}
			print $q->end_html();
		}else{
			my $cookiesid = new CGI::Cookie(-name=>'sess_id',-value=>'');
			print $q->header(-cookie=>[$cookiesid]), $q->start_html('Email Secretary'),
			      'Please wait...',
			      '', $q->end_html();
			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(),
		      "\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', '_'); # no dot in a filename
	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);
}

sub get_maildir {
	my $email = shift || die "get_maildir syntax error\n";
	my ($dir,$maildir);
	my($user,$domain) = split(/\@/, $email); # we dont support routing data
	open(A, '/var/qmail/users/assign') || die "cannot open assign: $!\n";
	while(){
		if(/^\+${domain}\-:[^:]+:\d+:\d+:([^:]+):/){
			$dir = $1;
			last;
		}
	}
	close A;
	
	open(V, "$dir/vpasswd") || die "cannot open $dir/vpasswd: $!\n";
	while(){
		if(/^${user}:[^:]+:\d+:\d+:[^:]*:([^:]+):/){
			$maildir = $1 . "/Maildir";
			last;
		}
	}
	close V;

	die "cannot find maildir for $email\n" unless(defined($maildir));
	return($maildir);
}

sub move_files {
	my $dbh = shift || die "move_file syntax error: dbh\n";
	my $q = shift || die "move_file: no reference to CGI\n";
	my $email = shift || die "move_file syntax error: email\n";
	my $sender = shift || die "move_file syntax error: sender\n";
	my $emailid = shift || die "move_file syntax error: emailid\n";
	my $maildir = shift;

	die "emailid doesnt look right: $emailid\n" unless($emailid =~ /^\d+$/);

	$maildir = get_maildir($email) unless($maildir);
	my($user,$domain) = split(/\@/, $email); # we dont support routing data

	my $sql = 'SELECT filename FROM messages WHERE sender = ' . $dbh->quote($sender);
	$sql .= ' AND emailid = ' . $dbh->quote($emailid); # authenticate all msgs from sender to this emailid
	my $sth = $dbh->prepare($sql);
	$sth->execute;
	my $file;
	while(my $row=$sth->fetchrow_arrayref){
		$file = $row->[0];
		my $sqla = 'DELETE FROM messages WHERE filename = ' . $dbh->quote($file);
		$sqla .= ' AND sender = ' . $dbh->quote($sender);
		my $stha = $dbh->prepare($sqla);

		$stha->execute || die "sql error: $!\n";
		if($forward_host){
			if(open(F, "${maildir}/pnd/${file}")){
				if(open(SENDMAIL, "|/var/qmail/bin/sendmail ${user}\@${forward_host}")){
					while(){
						print SENDMAIL;
					}
					close SENDMAIL;
					unless(unlink("${maildir}/pnd/${file}")){
						print "could not unlink ${maildir}/pnd/${file}: $!\n";
					}
				}else{
					print "could not fork sendmail: $!\n";
				}
				close F;
			}else{
				print "couldnt transfer file ${maildir}/pnd/${file}: $!\n";
			}
		}else{
			unless(rename("${maildir}/pnd/${file}","${maildir}/new/${file}")){
				print "cannot rename ${file}: $!\n";
			}
		}
	}

	$sql = 'INSERT INTO email_whitelists (addr,emailid) VALUES (' . $dbh->quote($sender);
	$sql .= ',' . $dbh->quote($emailid) . ')';
	$sth = $dbh->prepare($sql);
	$sth->execute || die "cannot whitelist $sender: $!\n";
	
	unless(defined($file)){
		print $q->header(), $q->start_html('Email Secretary'),
		      "It doesnt appear I have any messages from $sender in my Pending folder.
\n",
		      "Either they have already been delivered to my Inbox, have expired, or
\n",
		      "I simply havent heard from you before.
\n",
		      $q->end_html();
		exit;
	}
}

sub pfooter {
	if(shift){
		print 'Back To Main Menu

';
	}
	print '
',
	      '',
	      "ESec: Email Secretary v${version}
\n",
	      'copyright © 2004-2006 Jeremy Kister.
', "\n";
}