#!/usr/bin/perl -w 
#  Websieve Cyrus Mail Account Management Tool by Alain Turbide  
#
$version="0.63a";
use CGI qw(:standard :html3);
use CGI::Carp qw(fatalsToBrowser set_message);


#predeclare variables from websieve.conf
use vars qw($sieveport $imapport $defaultscript $allowadvanced $header1);
use vars qw($maildomain $mailhostappend $problem_email @namespaces $includepublic);
use vars qw($usereply $usereject $useacl $usediscard $usevariablefield);
use vars qw($useregex $usevacation $usereply $shortacl $usemulti $usematches);
use vars qw($usesearchflg $usecustom $keepredirect $quotemailbox $tb $cb $bg);
use vars qw($showmenu $showhome $showserver $nobyline $expires $OLDMODIFY);
use vars qw($LOGOUTURL $HOMEURL $HELPURL $VIEWRULESURL $SETVACATIONURL);
use vars qw($SETACLURL $ADDRULEURL $SETPASSWORDURL $ADVANCEDURL $ADMINMENUURL);
use vars qw($FORWARDALLURL $useforwardall $IMAPERROR $SIEVEERROR $imap);
use vars qw($server_hosts $useserverselect $useimapSSL $usesieveSSL);
use vars qw($returntoview $usesize $err @list %vacation %modevals @serverlist);
use vars qw($uid $res $scriptname $scriptdef $pseudo $mode $sieve);
use vars qw($imapserver $pass $op $msgdest $namespace $regexflg $regexbit);
use vars qw($sizeflg $copyflg $copybit $searchbit $tmp $matchflg $version);
use vars qw($sizebit $change $line $script $oldscript $oldmode $rules);
use vars qw($useauth %scripts $rulelist $rulesorig $delimiter $skey);
use vars qw($useservercookie $alt_namespace $vacation_prelude $userc4 $maxrules);
use vars qw($useldapextras $gomodifyit $ldappassattr $LDAP_SERVER);
use vars qw($LDAP_BASEDN $ENCRYPT_PASS $selectbyacl $partition);
use vars qw($keepbit $keepflg $ismanager $cyrusadminuid $unixhiersep);
use vars qw($sendcmd $touser $fromuser $useprocmail );
$unixhiersep="\." if !$unixhiersep;

if( $useldapextras ) {
        use vars qw($NEWUSERURL $NEWGROUPURL $LDAPSEARCHURL $manageruid);
        use vars qw(%ldapdefgroupatts %ldapdefpersonatts @ldappersonatts);
        use vars qw($ldapmemberatt $ldapgroup_ou $ldapperson_ou $mgrrecmail);
        use vars qw(%donotdisplay $suggestpass $allowchghost $mailhostatt);
}

#default to using RC4 encryption for cookies of $userc4 not defined
$userc4=1 if !defined $userc4;
$maxrules=400;

BEGIN {
	sub handle_errors {
		my $msg =shift;
		if ($msg=~/login|unknown/i) {
			&incorrect_login;
		}
		else {
			print"<h2>Received a program error!</h2>Error: $msg";
		}
	}
	set_message(\&handle_errors);
	$program_url= url(-absolute=>1) if !$program_url;
	require './funclib.pl';
	require './websieve.conf';
	# get the list of available imap servers 
	@serverlist=keys %server_hosts;

	if ($useauth) { require './auth.pl';}
	if ($useldapextras) {
	    require './ldapextras.conf';
	    require './ldapextras.pl';
	}

}

if ($useprocmail) {
    $allowadvanced=0;
    $useregex=0;
    $usesearchflg=0;
    $usemulti=0;
}
$remote_host=remote_host();

if (!$skey) {
	print header,"<H1> Variable \$skey in websieve.conf NOT set!<br>You <b>MUST</b> set this  variable  to a random string of characters for encryption of Cookie data" ;
	exit;
}

my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
$skey=$yday.$skey.$yday;
$session_exp='1800' if !$session_exp;


$notflghash='';
$copybit=1;
$sizebit=2;
$searchbit=4;
$keepbit=8;
$regexbit=128;
$error='';
$sencode_params='';
%modevals = (
	"on","Yes",
	"off","No");

$op='' if !$op;
if (param('op')) {
     if (param('op') eq 'logout' || param('op') eq 'login') {
	$auth_params{'uid'}='clear';
	$auth_params{'pass'}='clear';
	$encode_params=&encode_list(%auth_params);
	$encode_params=&Encrypt($encode_params,$skey) if !$userc4;
	$encode_params=&encrypt_rc4($skey,$encode_params) if $userc4;
	$encode_params=&encode_base64($encode_params) if $userc4;
	$auth_cookie=cookie(-name => 'websieve',
			-value=>$encode_params,
			-path=>"$program_url",
			-expires => 'now');
	print header(-cookie=> $auth_cookie);
	param('op','');
	print hidden('op');
	&web_authenticate;
	&byline;
	&closeimap;
	&closesieve;
	exit;
  }

}
$gotcookie='';

$encode_params=cookie('websieve');

if (!$encode_params) {
	$encode_params=param('s') if param('s');
}
if (!$encode_params && !param('login') )
{
	print header;
	&web_authenticate;
	&byline;
	exit;
} else {
	if (param('login')) {
	  $uid = param('login');
	  $pass = param('password');
	}
	else  {
	  $gotcookie=1;
	  $encode_params=&Decrypt($encode_params,$skey) if !$userc4;
	  $encode_params=&decode_base64($encode_params) if $userc4;
	  $encode_params=&encrypt_rc4($skey,$encode_params) if $userc4;
	  %auth_params=&decode_list($encode_params);
	  $uid=$auth_params{'uid'};
	  $pass=$auth_params{'pass'};
	  if ($uid eq 'clear') {
	  	print header;
	  	&web_authenticate;
		&byline;
		exit;

	  }
	  my $authhost=$auth_params{'remotehost'} if $auth_params{'remotehost'};
	  my $etime=$auth_params{'exp'} if $auth_params{'exp'};
	  if ((time - $etime) > $session_exp) {
	  	print header,"<b><center>Your Session has expired!</center></b><br>";
		&web_authenticate;
		&byline;
		exit;
	  }
	  if ($authhost && $authhost ne $remote_host) {
	  	print header," <b><center>Remote host does not match Session host!</center></b> <br>";
		&web_authenticate;
		&byline;
		exit;
	  }
	} # else param('login')

	  if (param('viewscript')) {
	  	$viewscript=param('viewscript');
		$gotcookie='';
	  }
	  else {
	  	$viewscript=$auth_params{'script'};
	  }
	  
	  param('viewscript',$viewscript);
	  if (param('server') ) {
	  	$userserver=param('server');
		$gotcookie='';
	  }
	  else {
	  	$userserver=$auth_params{'server'} if $auth_params{'server'};
          }
	 

	  if ($useauth && !$userserver) {
			# get imapserver address from auth database
			$userserver=&auth_getuserserver;

          }
	$userserver=&getserverdata($userserver);
	$auth_params{'uid'}=$uid;
	$auth_params{'pass'}=$pass;
	$auth_params{'server'}=$userserver;
	$auth_params{'script'}=$viewscript;
	$auth_params{'remotehost'}=$remote_host;
	$auth_params{'exp'}=time;
	$encode_params=&encode_list(%auth_params);
	$encode_params=&Encrypt($encode_params,$skey) if !$userc4;
	$encode_params=&encrypt_rc4($skey,$encode_params) if $userc4;
	$encode_params=&encode_base64($encode_params) if $userc4;	
	$auth_cookie=cookie(-name => 'websieve',
			-value=>$encode_params,
			-path=>"$program_url",
			-expires => $expires);
	if ($uid ne "" && $pass ne "")
	{
	   if (&bind < 0)
	   {
	       print header;
	     &incorrect_login;
	   }
	} else  {
	print header;
	   &incorrect_login;

	}

	if (!$allowadvanced) {
		foreach $advanceduser (@advanceduser) {
			$allowadvanced=1 if $uid=~/^$advanceduser/i;
		}
	}
	
	$sencode_params=&URLEncode($encode_params) if $useservercookie;
#	$sencode_params=&URLEncode($encode_params) if !$gotcookie;
	
	&addservercookie($sencode_params) if !$gotcookie;
#	$useservercookie=1 if !$gotcookie;	
	if (!$gotcookie && !$useservercookie) {
		print header(-cookie=> $auth_cookie);
	}
	else {
		print header;
	}
	$ismanager=1 if (($uid eq $manageruid) || ($uid eq $cyrusadminuid));
	undef $gotcookie;
	&modify_screen;
	&closeimap;
	&closesieve;
	print hr if $op ;
	&byline if ($op ne 'ldapsearch');
	exit;
}

sub addservercookie {
	my ($cookie) =@_;
	$VIEWRULESURL=~s/>/&s=$cookie>/;
	$FORWARDALLURL=~s/>/&s=$cookie>/;
	$SETVACATIONURL=~s/>/&s=$cookie>/;
	$SETACLURL=~s/>/&s=$cookie>/;
	$ADDRULEURL=~s/>/&s=$cookie>/;
	$SETPASSWORDURL=~s/>/&s=$cookie>/;
	$ADVANCEDURL=~s/>/&s=$cookie>/;
	$ADMINMENUURL=~s/>/&s=$cookie>/;
	
}
sub initscripts {
	my ($scriptname,$scriptdef,$mode,$viewscript,$scriptsave,$deletescript,$scriptlist);
	my (%scripts)=@_;
	$scriptdef=$scripts{'scriptdef'};
	$mode=$scripts{'mode'};
	$scriptlist=$scripts{'scriptlist'};
	$viewscript=$scripts{'viewscript'};
	$scriptname=$viewscript;
	$deletescript='';
	my @scriptlist;
	@scriptlist=split (/ /,$scriptlist);
	if ($scripts{'active'} && $viewscript eq $scripts{'active'}) {
		$scriptdef='on';
	}
	$scriptdef='on' if !$usemulti;
	param("lastviewscr",$viewscript);
	print hidden("lastviewscr",$viewscript);

       	param("viewscript",$viewscript);
        param("scriptname",$scriptname);
	param("deletescript",$deletescript);
	if ($op eq 'advanced') { 
		print "<hr>";
		print "<TABLE border=1 width=100%><TR $cb><TD $tb>";
 	  	print "<b><center>Advanced Settings</b></center>";
		print "</TD><TR $cb><TD><TABLE >";
	}
	if ($usemulti && $op eq 'advanced') {

		print "<TR><TD $cb><b>Current Scripts:</b></TD><TD $cb>",$scriptlist," (currently active script shown with *)</TD></TR>";	
		
		param("scriptdef",$scriptdef);
		print "<TR><TD $cb><b>Activate Script?:</b></TD> <TD $cb>",radio_group("scriptdef",['off','on'],$scriptdef,'',\%modevals),"</TD></TR>";
	
	        print "<TR><TD $cb><b>Edit script name:</b></TD> <TD $cb VALIGN=TOP>",textfield("viewscript",$viewscript,12,""),"</TD></TR>\n";
		print "<TR><TD $cb><b>Save to script name:</b></TD> <TD $cb VALIGN=TOP>",textfield("scriptname",$scriptname,12,""),"</TD></TR>";
  	}
	else {
		print hidden("scriptdef",$scriptdef);
		print hidden("viewscript",$viewscript);
		print hidden("scriptname",$scriptname);
	}
      if ($usemulti && $op eq 'advanced')
       { 
	print "<TR><TD $cb><b>Delete script name:</b></TD> <TD $cb VALIGN=TOP>",textfield("deletescript",$deletescript,12,""),"</TD></TR>\n";
	}
		
	if ($allowadvanced && $op eq 'advanced')
	 {
		param("mode",$mode);
       		 print "<TR><TD $cb><b>Script Mode:</b></TD> <TD $cb>",radio_group("mode",['basic','advanced'],$mode,'',''),"</TD></TR>\n";
	}
	else {
		param("mode",$mode);
		print hidden("mode");
	}

	print "</TABLE></TD></TABLE>";
	print "<b>NOTE:&nbsp;You will lose ALL changes made to a script in advanced mode if you switch back to basic mode.</b>" if ($mode eq 'advanced' && $op eq 'advanced');
}


sub printpass {
	print "<TABLE border=1 width=100%><TR $cb><TD $tb>"; 
   	print "<b><center>Change Password</b>","</center>";
	print "</TD><TR $cb><TD><TABLE >";
	print "<TR><TD $cb><b>User ID:</b></TD><TD $cb>",textfield('authuser'),"</TD></TR>\n" if ($ismanager && $useauth);
	print "  <TR><TD $cb><b>New Password:</b></TD><TD $cb>",password_field('pass1'),"</TD></TR>\n";
	print "  <TR><TD $cb><b>New Password (again):</b></TD><TD $cb>",password_field('pass2'),"</TD></TR>\n";
	print "</TABLE><TABLE CELLSPACING=1 BORDER=0 CELLPADDING=2 >\n";
	print "</TD></TABLE></TABLE>";
}

sub modifyacl {
	my $mbx="";
	my $err="";
	return if (defined param('Select'));
	return if (defined param('Save Changes'));
	return if (param('action') && param('action') eq 'confirmmbxdel');
	$mbx=param("mbx") if defined param("mbx");
	my $partition = param('partition') if param('partition');
	my $acl='';
	my $generalrights='';
	$generalrights=param('rights') if defined param('rights');
	$acl=join('',param('acl')) if defined param("acl");
	$acl=$generalrights.$acl;
	my ($useracl)="";
	$useracl=param('acluser') if defined param('acluser');
	my $maxquota;
	$maxquota=param('aclmaxquota') if defined param('aclmaxquota');
	my ($newmbx)="";
	$newmbx=param('newmbx') if defined param('newmbx');
	$mbx=~s/^ +//g;
	$mbx=~s/ +$//g;
	my $mbxorig=$mbx;
	$userspace=1;
	# check if folder is in an additional namespace
	if (param('Select Folder')) {
		my $selected=param('selectedmbx');
		$selected=~/^\[([^\]^\[]*)\]/;
		$selected=$1;
		param('mbx',$selected.'*');
		return;
	}
	if (param('Select Server')) {
		my $imapserver=param('server');
		return;
	}
	if (param('Up One Level')) {
		my $selected=param('selectedmbx');
		$selected=~/^\[(.*?)\]/;
		$selected=$1;
		$selected=~s/$unixhiersep?[^.]+$//;
		param('mbx',$selected.'*');
		param('selectedmbx','');
		return;
	}

	foreach $namespace (@namespaces) {
		if ($newmbx) {	
			if ($newmbx=~/^$namespace./i) {
				$mbx="$newmbx";
				$userspace=0;
				last; # stop checking
			}
		}		
		elsif ($mbx=~/^$namespace./i) {
			$userspace=0;
			last;  # stop checking
		}
	}
			
	if ($userspace) {
		if ($alt_namespace) {
			if ($mbx) {
				$newmbx=$unixhiersep.$newmbx if $newmbx;
			}
			$mbx="".$mbx.$newmbx."";
		}
		else {
##			$mbx=~s/^INBOX/user$unixhiersep$uid/i;
			$newmbx=$unixhiersep.$newmbx if $newmbx;
			$mbx="".$mbx.$newmbx."";
		}
	}
	if ($ismanager && !$newmbx) {
		$mbx=$mbxorig;
	}
	elsif ($ismanager) {
		$mbx=$newmbx;
		$mbx=~s/^$unixhiersep//;
	}
	my $change;
	#print br,"mbx=$mbx, newmbx=$newmbx",br;return;

	if ($newmbx && param('Create Mailbox')) {
		$err=&createmailfolder($mbx,$partition);
		if ($err) {
		    print hr,"<b>Createmailbox Error:</b> $err<br>";
		    return;
		}
		else {
		    $change=1 ;
		    if ($ismanager) {
		      param('mbx',$mbx);
		      print hidden('mbx');
	            }
		}
	}
	if (!$mbx || !(( $acl && $useracl) || $maxquota)) {
		return;
	}
	if (param('Set Acl')) {
	  $mbx="\"$mbx\"" if ($quotemailbox==1);
	  if ( $mbx && !&listmailbox($mbx)) {
		 $err="Mailbox does not exist!";
	  }
	  else {
		$err=&setacl($mbx,$useracl,$acl);	
		$change=1;
	 } 
	}
	if ($maxquota && param('Set Quota')) {
		$err=&setquota($mbx,$maxquota);
		$change=1;
	}

	if ($err) {
		print hr,"<b>Error</b> modifying $mbx, Err: $err\n",br;
		return;
	}
	print hr,"Mailbox modification successful..<br>" if $change;
	return;
}


####  View ACL's

sub viewacl
{
	my ($tmp,@acl);
	my (%aclhash) =(
		"l"=>"[l]ook",
		"r"=>"[r]ead",
		"s"=>"[s]een",
		"w"=>"[w]rite",
		"i"=>"[i]nsert",
		"p"=>"[p]ost",
		"c"=>"[c]reate",
		"d"=>"[d]elete",
		"a"=>"[a]dmin",
		#"none"=>"No Access"
	);
	my $mbx;
	$mbx=param('mbx') if param('mbx');
	if ($ismanager) {
		#$mbx="INBOX*" if !$mbx;
		$mbx="user".$unixhiersep.$uid.$unixhiersep."*" if !$mbx;
		@mailboxes=&listmailbox($mbx) ;
	}
	if (param('Delete This Mailbox') && param('delmailbox')) {
	    param('Delete This Mailbox','');
	    param('action','confirmmbxdel');
	    &confirmmbxdelete;
	    print hidden('action');
	    print end_form;
	    print end_html;
	    exit;
	}
	my $subtext="Folder";
	$subtext="Mailbox" if $ismanager;

	my (%rightshash)=(
		"lrs"=>"Read (lrs)",
		"lrsp"=>"Post (lrsp)",
		"lrswipcd"=>"Write (lrswipcd)",
		"lrsip"=>"Append (lrsip)",
		"lrswipcda"=>"All (lrswipcda)",
		"lrswipd"=>"Write-no create(lrswipd)",
		"none"=>"Remove access (none)"
	);
	my (@rights)=("lrs","lrsp","lrswipcd","lrsip","lrswipcda","lrswipd","none");
	my (@acls)=("l","r","s","w","i","p","c","d","a","none");
    
   print "</TABLE>",hr;
   print "<TABLE border=1 width=100%><TR $cb><TD $tb>";

     	my (@tmpmbx,$eachmbx,$eachfolder);
	my ($user,$useracl);
   print "<b><center>ACL View for user mailbox</b>","</center></TD><TR $cb><TD >";
   	print "<TABLE >";

	print "<TR $cb>";
	if ($shortacl ) {	

		print "<TD  ><b>[$subtext]-->UserID [acl]</b></TD></TR>";
	}
	else
		{
		print "<TR><TD $tb><b>Folder Name</b></TD><TD $tb><b>UserID [acl]</b></TD></TR>";	
	}
	@tmpmbx=@mailboxes;
	undef @acl;
	my (@tmp,$acl_tmp,$user_tmp);
	while (@tmpmbx) {
		$eachmbx=shift(@tmpmbx);
		next if ($eachmbx!~/\S/);
		$eachfolder="$eachmbx";	

		# check if folder is in an additional namespace
		foreach $namespace (@namespaces) {
			if ($eachmbx=~/^$namespace./i) {
				$eachfolder="$eachmbx";
				last;	# stop checking
			}
		}
		$eachfolder="\"$eachfolder\"" if ($quotemailbox==1);
		 
		@tmpacl=&getacl($eachfolder) if $eachfolder;
#		print "tmpacl=$eachfolder==@tmpacl<br>";
		$tmp=join(' ',@tmpacl);
		#remove stray mailbox names that have spaces
		$tmp=~s/^.*?" *//;	
		@tmp=split(/ /,$tmp);	
#		print "tmp2acl=$tmp<br>";
		$tmp='';
		while (@tmp) {
			$user_tmp=shift(@tmp);
			next if !$user_tmp;
			$acl_tmp="[".shift(@tmp)."]" if @tmp;
			$tmp.=", " if $tmp;
			$tmp.="$user_tmp=$acl_tmp";
		}

		if ($shortacl) {
			if (!$tmp) {
				$tmp='<empty>';
			}
				
			$tmp="[$eachmbx]---->".$tmp;
			push (@aclview,$tmp);
		}
		else {
			print "<TR><TD ><b>$eachmbx</b></TD><TD $cb>$tmp</TD></TR>";

		}

	}
	@tmpbox=@mailboxes;
	push (@tmpbox," ") if $alt_namespace;
        print "<TR><TD >",popup_menu('selectedmbx',[@aclview],' ') if ($shortacl);
	print "&nbsp;&nbsp;".submit('Select Folder')."&nbsp;".submit('Up One Level')."</TD></TR>" if ($shortacl && $ismanager);

	print "</TABLE>";
	print "</TD></TABLE>";
   print br,"<TABLE border=1 width=100%><TR $cb><TD $tb>";
	$mbx=shift(@tmpbox);
        param('mbx',$mbx);
        param('acluser','');
        param('newmbx','');
	param('acl','');
	param('rights','-');

   print "<center><b>Access Control List Entry:</b> $uid","</center></TD><TR $cb><TD>" if !$ismanager;
   	print "<center><b>Mailbox ACL and Quota Management</b></center></TD><TR $cb><TD>" if $ismanager;
	print "<TABLE>";
        print "<TR $cb><TD><b>$subtext:</b></TD><TD $cb>";
	if (!$ismanager) {
                print popup_menu('mbx',[@tmpbox],' ')."</TD></TR>";
	} else {
		print textfield("mbx","",48)."&nbsp;&nbsp;&nbsp;".submit("Select","Select $subtext")."&nbsp;&nbsp;(Wildcards allowed [*])</TD></TR>";
	}
	
	print "<TR><TD $cb ><b>Foreign User ID:</b></TD>";
        print "<TD $cb>".textfield("acluser")."&nbsp;(User ID to assign access rights) &nbsp;".submit("Set Acl")."</TD></TR>";

	print "<TD><b> General Rights:</b></TD><TD $cb>".radio_group('rights',[@rights],"-",'',\%rightshash)."</TD></TR>";	
	print "<TR><TD $cb><b>Specific Rights:</b></TD><TD $cb>".checkbox_group('acl',[@acls],'','',\%aclhash)."</TD></TR>";
	if ($ismanager) {
		my @imapquota=&getquota($mbx) if ($havequota || !$useprocmail);
		param('aclmaxquota','');
		param('aclmaxquota',$imapquota[2]);	
		print "<TR><TD><$cb><B>Disk Quota Limit (KB):</b></TD><TD $cb>";
		print textfield('aclmaxquota',$imapquota[2],20,40);
	   print "&nbsp;&nbsp;<b>Disk Quota Used (KB):</b>&nbsp;&nbsp;".$imapquota[1]."&nbsp;&nbsp;".submit("Set Quota")."</TD></TR>";
	}
	print "</TABLE>";
	print "</TD></TABLE>",br;
  	print "<TABLE border=1 width=100%><TR $cb><TD $tb>";
   	print "<b><center>New Folder Creation</b></center></TD><TR><TD $cb>" if !$ismanager;
   	print "<b><center>$subtext Creation</b></center></TD><TR><TD $cb>" if $ismanager;

	print "<TABLE>";
	param('delmailbox','');
	param('newmbx','');
	param('partition','');
	print "<TR><TD $cb ><b>$subtext to Create:</b></TD><TD $cb>".textfield("newmbx")."&nbsp;&nbsp;";
	print "<b>Partition: </b>",textfield("partition") if $ismanager;
	print"&nbsp;&nbsp;". submit('Create Mailbox',"Create $subtext")."&nbsp;&nbsp;</TR>";
	print "<TR><TD $cb ><b>$subtext to Delete:</b></TD><TD $cb>".textfield("delmailbox")."&nbsp;&nbsp;&nbsp;".submit("Delete This Mailbox","Delete $subtext")."</tr>" if $ismanager;
		print "<TR><TD $cb><b>Mail Server:  </b></TD><TD $cb>",popup_menu("server",[@serverlist],$imapserver,\%serverdisplay) 
		. "&nbsp;&nbsp;&nbsp;".submit("Select Server","Select Server")."</tr>" if $ismanager;

	print "</TABLE>";
	print "</TD></TABLE>";
  }

sub getuserinfo {
	my ($res,$script,$mode,$pseudo,$oldmode);
	my (@tmpboxes,@tmprules,@tmpscr);
	my (@scriptlist,$scriptlist,$scriptname,$scriptdef);

 	undef @rules;
	undef @mailboxes;
	undef @quota;
	undef %vacation;
	undef %scripts;

#creates global variables $mode,@rules,@mailboxes,@quota and %vacation;
# get quota
	@quota=&getquota("INBOX") if ($havequota || !$useprocmail);
	if ($IMAPERROR !~ /no errors/i && !$ismanager && $IMAPERROR) {
		$error=$IMAPERROR;
		&closeimap;
		&closesieve;
		&incorrect_login;
		exit;
	}

#print "quota=@quota";
# get mailboxes
	@tmpboxes=&listmailbox("*") if (!$ismanager);
	# remove "user.userid" prefix
	#place empty element in @mailboxes for display purposes
	push (@mailboxes,' ');

	while (@tmpboxes) {
		$tmpline=shift(@tmpboxes);
		chomp($tmpline);
		$tmpline=~s/\r//g;

		if ($alt_namespace) {
			$tmpline=~s/^ *user$unixhiersep$uid$unixhiersep* * /INBOX$unixhiersep/i;
		}
		else {
			$tmpline=~s/^ *user$unixhiersep$uid$unixhiersep* *//i;
		}
		
		#thiswill be set true if "anyone" identifier has any privs
		# for the folder defined by $tmpline
		my $public=1;

		#this will be set true if this user has admin privs for
		#this folder
		my $ownedbyuser = 0;
		#Display all folders if Manager is user
	       $includepublic=1 if $ismanager;	
	       if ($selectbyacl) {
		my @tmpacl = &getacl($tmpline);
		#following 5 lines fix returned acl values when folders contain
		# spaces when using IMAP::Admin
		$tmp=join(' ',@tmpacl);
		#remove stray mailbox names that have spaces
		$tmp=~s/^.*?" *//;	
		@acl=split(/ /,$tmp);	
		$tmp='';

		while(@acl) {
			my $line=shift(@acl);
			$public = 1 if ($line=~ /anyone/i);
			if ($line=~/$uid/i) {
				my $useracl=shift(@acl);
				$ownedbyuser=1 if ($useracl=~/a/i);
			}
		}

		$tmpline = "" if (($public)&&(!$ownedbyuser)&&(!$includepublic));
	       }
	       else {
	       	
		if (($tmpline!~/^INBOX|$uid/i) && (!$includepublic)) {
		$tmpline="";
		}
	      }
		push (@mailboxes,$tmpline) if ($tmpline=~/\S/);
		

	}
# get mailboxes from other namespaces
	foreach $namespace(@namespaces) {
		push (@mailboxes,&listmailbox("$namespace.*"));
	}

#get scriptlists
      if (!$useprocmail) {
	&opensieve($uid,$pass,$sieveport,$imapserver) if (!$sieve);	
        if (!$sieve) {
                print start_html(-title=>'Error login in to Sieve Server',-BGCOLOR=>'red'),
                h2("Error login in to Sieve Server: $imapserver <br>"),
                "There is a problem accessing the Sieve Server, click <a href=" . $program_url . "?op=login>HERE</a> and try again.\n";
                &closesieve;
                &closeimap;
                exit;
         }
	@scriptlist=&listscripts;
	while (@scriptlist) {
		$_=shift(@scriptlist);
		if (/\*|ACTIVE/) {
			$defaultscript=$_;
			$defaultscript=~s/\*| *ACTIVE//g;
			$_="<b>".$defaultscript."*</b>";	
			$scripts{'active'}=$defaultscript;
			

		}
		if ($scriptlist) {$scriptlist.=', ';}
		$scriptlist.=$_;
	}
	if (!param('viewscript')) {
		$scriptname=$defaultscript;
		$viewscript=$defaultscript;
		$scriptdef='off';
	}
	else {
		$scriptname=param('scriptname');
		$viewscript=param('viewscript');
		
		$scriptdef=param('scriptdef');
		
	}
       } # if not useprocmail

# get sieve scripts
      if (!$useprocmail) {
      
	$pseudo=&getscript($viewscript."_pseudo");
	$script=&getscript($viewscript);
	$script=$script.$pseudo;
       } 
       else {
       	  $script=&auth_getattrib($matchingrules);
       }

	if ( $SIEVEERROR && $SIEVEERROR !~ /No Error/i && $SIEVEERROR !~ /doesn.t exist/i) {
		print "Error: getscript->".$SIEVEERROR."<br>";
	}
	#combined script and pseudo files to enable easy compatibility with old method
	#of having rules in same file as script

	@tmprules=split(/\n/,$script) if ($script);
	@tmpscr=grep !/#rule|#mode|#vacation|##pseudo/i,@tmprules;
	#remove pseudo rules and CR's from main script
	$script=join("\n",@tmpscr);
	@tmprules=grep  /^ *\#\#pseudo|^ *#rule|^ *#mode|^ *#vacation/i, @tmprules;
	$pseudo=join("\n",@tmprules);
	while (@tmprules) {
		$_=shift(@tmprules);
		if (s/^ *#rule&& *//i) {
			s/\r//g;
			push(@rules,$_);
		}
	
                elsif (/^ *#vacation&&(.*)&&(.*)&&(.*)&&(.*)/i) {
			$vacation{'days'}=$1;
			$vacation{'addresses'}="$2";
			$vacation{'text'}=$3;
			$vacation{'mode'}=$4;
			$vacation{'addresses'}=~s/\\@/\@/g;
			$vacation{'addresses'}=~s/\"//g;

		}
	       elsif (/^ *#mode&&(.*)/) {
	       		$mode=$1;
			$oldmode=$mode;
		}
		
	}
        if ( !defined %vacation) {
               $vacation{'mode'}='off';
               $vacation{'days'}='1';
               $vacation{'text'}='On vacation for the next week';
        }
	if (!$vacation{'addresses'}) {
               $vacation{'addresses'}="$uid\@$maildomain $uid\@$mailhostappend";
	}

	if ($allowadvanced && param('mode') && (param('viewscript') eq param('scriptname'))) {
		$mode=param('mode');
	}
	elsif (!$allowadvanced || !$mode)  {
		$mode='basic';
	}
	
	$scripts{'script'}=$script if $script;
	$scripts{'pseudo'}=$pseudo;
	$scripts{'mode'}=$mode;
	$scripts{'oldmode'}=$oldmode;
	$scripts{'scriptname'}=$scriptname;
	$scripts{'viewscript'}=$viewscript;
	$scripts{'scriptlist'}=$scriptlist;
	$scripts{'scriptdef'}=$scriptdef;
	$scripts{'deletescript'}=param('deletescript');	
	return %scripts;
}

sub printscript {
	my ($script)=@_;	
	param("script",$script);
	print "<HR><TABLE border=1 ><TR $cb><TD $tb><center><b>Sieve Script Edit</b></center></TD>";
        print "<TR><TD $cb>",textarea("script",$script,30,100,"","wrap=virtual"),"</TD></TR>";
	
	print "</TABLE>";

}


# print web form and display all current rules
# also display form to accept a new rule

sub printrules {
#	my (@fieldlist)=("subject","from","to");
	my (%actions,%contain);	
	my (@ruletype)=('DISABLED','ENABLED','DELETE','MODIFY');
	my (@desttype)=("folder","address");
	my ($fieldname,$fieldval,$sdest,$sdest1,$sto,$sfrom,$ssubject,$destt,$sdest2,$sdest3,$check1,$check2,$check3,$check4,$check5,$joinop,$size);
	my ($applyall,$searchflg);
	my ($sfield,$svalues,$scopyflg,$sregexflg,$sfieldname,$sfieldval,$ssize,$skeepflg);
	$ssize=$sfieldname=$sfieldval=$sfrom=$sto=$ssubject=$sdest=$sdest0=$sdest1=$sdest3=$check3=$check4='';
	$sflg=$ssizeflg=0;
	push (@desttype,' ');
	# retrieve rules string from global hash %record where key is matchingrules
	#convert rules string to an array
	$sdest=$svalues=$sfield;
	$scopyflg='';
	$sregexflg='';
	$skeepflg='';
	my ($sdestt)='folder';
	%actions = ( 
		"folder","File Into",
		"address","Forward To",
		"reply","Reply with",
		"reject","Reject",
		"discard","Discard"
		);
	
	my (@flgsts)=(0,1);
	%notflghash=(
		0,"contains",
		1,"does not contain",
		);
	%searchflghash = (
		0," all of ",
		1," any of "
		);
	%sizeflghash = (
		0," less ",
		2," greater "
		);
	%copyhash = (
		'keep',"Keep a copy in your Inbox",
		'copy',"Continue checking other rules after applying this rule",
		'regex',"Use regular expressions"
		);
	my ($toggle,$priority,$line,$dest,$field,$flg,$copyflg,$sizeflg,$keepflg);
	my ($rulecount)=0;
	my ($pcount)=1;	
 # insert view rules here..  
   if ($op eq 'viewrules' ) {

	print hr,"<TABLE border=1 width=100%><TR $cb><TD $tb>";
   	print "<b><center>Viewing Rules for:</b> $uid","</center>";

	print "</TD><TR $cb><TD><TABLE border=1 width=100%>";
	print "<TR><TD $tb width=18% align=right><b>[Rule#]  Priority - Status</b></TD><TD $tb align=center ><b>Current Rules</b></TD>";
	# only print if viewing...
   } # if viewrules

	@tmprules=@rules;
	$modrule="";
	while (@tmprules) {
		$line=shift(@tmprules);
		chomp($line);
		$line=~s/\s*//;
		$line=~s/\s$//;
		$line=~s/\r//g;
		($priority,$ruletype,$from,$to,$subject,$destt,$dest,$flg,$fieldname,$fieldval,$size)=split('&&',$line);	
		if ((!($from || $to || $subject || $size || ($fieldname&&$fieldval)) || !$ruletype) && !$dest) {
			next;
		}
		#this line to support old version of websieve scripts
		if ($flg=~/copy/i) {
			$flg=$copybit;
		}
		$flg=0 if !$flg;
		$copyflg= ($flg & $copybit);
	        $searchflg=($flg & $searchbit);
		$searchflg=0 if !$searchflg;
		$sizeflg=($flg & $sizebit);
		$regexflg=($flg & $regexbit);
		$keepflg=($flg & $keepbit);
		$priority=$pcount;
		$applyall='';
		$applyall=1 if (!($to | $from | $subject | $fieldname | $fieldval | $size) && $dest);
		# if it is a modify rule then save this rule for modify later
		if (($ruletype=~/modify/i || ($applyall && $op eq 'forward' && $destt eq 'address')) && !($sto || $sfrom || $ssubject || $sdest || $ssize)) {
			# can use 'DELETE' but data loss in form submit might cause a new rule to be lost if using IE
			$ruletype=$OLDMODIFY;
			$sto=$to;
			$sfrom=$from;
			$ssubject=$subject;
			$modrule="1";
			$spriority=$priority-1;
			$sdestt=$destt;
			$sdest=$dest;
			$scopyflg=$copyflg;
			$ssizeflg=$sizeflg;
			$skeepflg=$keepflg;
			$sflg=$flg;
			$sregexflg=$regexflg ;
			$ssearchflg=$searchflg;
			$sfieldname=$fieldname ;
			$sfieldval=$fieldval ;
			$ssize=$size;
			# save values for modify later
		}
		
		param("rules.priority.$rulecount","$priority");
		param("rules.ruletype.$rulecount",$ruletype);
		param("rules.searchflg.$rulecount",$searchflg);
	     if ($op eq 'forward' && $ruletype=~/DELETE/i) {
	     		print hidden("rules.priority.$rulecount");
			print hidden("rules.ruletype.$rulecount");
	     }
	     if ($op eq 'viewrules' ) {
		# only print if viewer
		print "<TR>\n";
		print "<TD $cb align=right valign=top>[<b>$rulecount</b>] ",textfield("rules.priority.$rulecount",$priority,2), popup_menu("rules.ruletype.$rulecount",[@ruletype],$ruletype),"</TD>";
		print "<TD $cb >";
	      if ($destt ne 'custom' ) {
	       
		print "IF " if !$applyall;
		print "<b>[Unconditional Rule]</b> " if $applyall;
		$searchflg=0;
		$searchflg=1 if ($flg & $searchbit);
		# only if viewing
		my ($wc)='';
		my %contains;
		if ($regexflg) {
			$contains{'to'}=$contains{'from'}=$contains{'subject'}=$contains{'field'}='matches regex';
		}
		else {
			
			$contains{'to'}=$contains{'from'}=$contains{'subject'}=$contains{'field'}='contains';
			$contains{'to'}='matches' if $to=~/\*|\?/;
			$contains{'to'}.='{not} ' if $to=~/^\s*!/;
			$contains{'from'}='matches' if $from=~/\*|\?/;
			$contains{'from'}.='{not} ' if $from=~/^\s*!/;
			$contains{'subject'}='matches' if $subject=~/\*|\?/;
			$contains{'subject'}.='{not} ' if $subject=~/^\s*!/;
			$contains{'field'}='matches' if $fieldval=~/\*|\?/;
			$contains{'field'}='{not} matches' if $fieldval=~/^\s*!/;
			$contains{'size'}='msg size <b>less</b> than';
			$contains{'size'}='msg size <b>greater</b> than' if $sizeflg;
			
		}
		$joinop='AND';
		$joinop='OR' if $searchflg;
			
			
		if ($from) {
			print "\'<b>From</b>\' $contains{'from'} \'<b>",$wc.$from.$wc,"</b>\' ";
		}
		if ($to) {
			if ($from) {print " $joinop field: ";}
			print "\'<b>To</b>\' $contains{'to'} \'<b>",$wc.$to.$wc,"</b>\'";
		}
		if ($subject) {
			if ($to | $from) {print " $joinop field: ";}
			print "\'<b>Subject</b>\' $contains{'subject'} \'<b>",$wc.$subject.$wc,"</b>\'";
		}
		if ($fieldname) {
			if ($to | $from | $subject) {print " $joinop field: ";}
			print "\'<b>$fieldname</b>\' $contains{'field'} \'<b>",$wc.$fieldval.$wc,"</b>\'";
		}
		if ($size) {
			my $kb='K';
			$kb="K" if $size=~s/k//gi;
			if ($to | $from | $subject | $fieldname) {print " $joinop ";}
			print " $contains{'size'} \'<b>$size"."$kb</b>\'";
		}
			
		#$dest=~s/^(.{40}).*/$1->(more)/;
		$dest=~s/\\n/<br>/g;	
		print " THEN " if !$applyall;
		print "$actions{$destt} "," \'<b>",$dest,"</b>\'";
	       } # if !$custom
	       else {
#		$dest=~s/^(.{40}).*/$1->(more)/;
		$dest=~s/\\n/<br>/g;
	      	print "<b>Custom Rule:</b> $dest";
	      }

		if ($copyflg) {	
			print " - [Continue]";
		
		}
		if ($keepflg) {
			print " - [Keep a copy]";
		}
		print "</TD>\n";


		print "</TR>";

		# only if viewing..

           } #if viewrules 

		$rulecount++;
		$pcount+=2;
	} # while
	if (!defined($spriority)) {$spriority=$pcount-1;}
	$savedcount=$rulecount;
	$sdest0=' ';
	# set up variables for modify operation on a rule 
	$check1='';
	$check2='';
	$check0='';
	$check5='';

	my $customrule='';
	if (!$sdest) {$sdest=' ';}	
	if ($sdestt=~/address/i) { 
		$sdest1=$sdest;
		$check1='checked';
	}
	elsif ($sdestt=~/reply/i) {
		$sdest2=$sdest;
		$sdest2=~s/\\n/\r\n/g;
		$check2='checked';
	}
	elsif ($sdestt=~/folder/i) {
		$sdest0=$sdest;
		$check0='checked';
	}
	elsif ($sdestt=~/reject/i) {
		$check3='checked';
		$sdest3=$sdest;
		$sdest3=~s/\\n/\r\n/g;
	}
	elsif ($sdestt=~/discard/i) {
		$check4='checked';
	}
	elsif ($sdestt=~/custom/i) {
		$customrule=1;
		$check5='checked';
		$sdest5=$sdest;
		$sdest5=~s/\\n/\n/g;
	}
			
	if ($op eq 'viewrules' ) { 
	print "</TABLE>";
	print "</TD></TABLE>";
	if (!$rulecount) {
		print " [No Rules avalailable]<br>";
	}
	print "<hr><center>",submit('Save Changes'),"&nbsp;&nbsp;",submit("Refresh"),"&nbsp;&nbsp;",reset("Reset Values"),"</center>";

	} # if viewrules
     if (($op eq 'addrule'  || $modrule) && ($op ne 'forward')) {
	$modrule="";
#### New Rule Entry
	my ($wild)="Hint: Use * or ? for wildcards<br> To invert a rule use ! as the first character of your search string" ;
	print hr,"<TABLE border=1 width=100%><TR $cb><TD $tb>";
	print "<center><b>New Rule Entry for user: </b>$uid</center></TD></TR><TR $cb><TD>";
	print "<TABLE >";
	print "<TR $cb><TD><b>Rule#: </b>[$rulecount]";
		print "&nbsp;&nbsp;<b>Priority: </b>",textfield("rules.priority.$rulecount",$spriority,2);
		print "&nbsp;&nbsp;<b>Status: </b>",popup_menu("rules.ruletype.$rulecount",[@ruletype],'ENABLED'),"</TD><TD></TR>";
	my @checked;
	my @checkvalues=("copy","keep");
	push @checkvalues,"regex" if $useregex;

	if ($scopyflg) {
		push @checked,"copy";
	}
	if ($skeepflg) {
		push @checked,"keep";
	}
	if ($sregexflg) {
		push @checked,"regex";
	}
	param("rules.copy.$rulecount",@checked);
		
	print "<TD $cb>";
	print "<b>",checkbox_group(-name=>"rules.copy.$rulecount",
			     -values=>\@checkvalues,
			     -defaults=>\@checked,
			     -linebreak=>'true',
			     -labels=>\%copyhash),"</b>";

	while (($rulecount==$savedcount) && ($rulecount<$maxrules)) {
		print "<TR border=1>\n";
		param("rules.ruletype.$rulecount",'ENABLED');
		param("rules.priority.$rulecount","$spriority");
		print "</TABLE><hr><TABLE >";
		print "<TR ><TD  >";
		param("rules.desttype.$rulecount","$sdestt");
###### FROM field
		print "<b>IF ";
		if ($usesearchflg) {
			$ssearchflg=0;
			$ssearchflg=1 if ($sflg & $searchbit);
			param("rules.searchflg.$rulecount","$ssearchflg");
			print popup_menu("rules.searchflg.$rulecount",[@flgsts],$ssearchflg,\%searchflghash);	
		}	
		print " field(s):</b></TD><TD $cb>&nbsp; 'from' contains ",
		"</TD><TD $cb >";
		param("rules.from.$rulecount","$sfrom");
		print textfield("rules.from.$rulecount","$sfrom",50),"</TD></TR>";
		
############# TO field
		print "<TR>";		
		print "<TD $cb align=right>&nbsp;</TD><TD $cb >";
		print "&nbsp; 'to' contains ",
		"</TD><TD $cb >";
		param("rules.to.$rulecount","$sto");
		print textfield("rules.to.$rulecount","$sto",50),"</TD></TR>";

########### SUBJECT field
		print "<TR></TD>";
		print "<TD $cb align=right>&nbsp;</TD><TD $cb>";
		print "&nbsp; 'subject' contains ",
		"</TD><TD $cb>";
		param("rules.subject.$rulecount","$ssubject");
		print textfield("rules.subject.$rulecount","$ssubject",50),"</TD></TR>";
		$usesize=1 if !defined $usesize;
		if ($usesize) {
##### Size of message rule 
		print "<TR></TD>";
		print "<TD $cb align=right valign=bottom>Msg size</TD><TD $cb>";
		param("rules.sizeflg.$rulecount","$ssizeflg");
		print popup_menu("rules.sizeflg.$rulecount",[(0,2)],$ssizeflg,\%sizeflghash);
		print " than ";
		print "</TD><TD $cb>";
		param("rules.size.$rulecount","$ssize") ;
		print textfield("rules.size.$rulecount","$ssize",15)," (K)ilobytes</TD></TR>";
		}

		if ($usevariablefield) {
##### Variable field 'field'
		print "<TR></TD>";
		print "<TD $cb align=right valign=bottom>Field name</TD><TD $cb>";
		param("rules.fieldname.$rulecount","$sfieldname");
		print textfield("rules.fieldname.$rulecount",$sfieldname,10);
		print " contains ","</TD><TD $cb>";
		param("rules.fieldval.$rulecount","$sfieldval") ;
		print textfield("rules.fieldval.$rulecount","$sfieldval",50),"</TD></TR>";
		}

######## THEN
####### Action FILEINTO 
		print "<TR>";
		print "<TD $cb><b>THEN</b></TD><TD $cb><input type=radio $check0 name=rules.desttype.$rulecount  value=\"folder\"> File Into  </TD><TD $cb>";
		param("rules.mailbox.$rulecount","$sdest0");
		if (!$ismanager) {
		    print popup_menu("rules.mailbox.$rulecount",[@mailboxes],"$sdest0");
		} else {
		    print textfield("rules.mailbox.$rulecount","$sdest0",50);
		}
		print " (Mail Folder) </TR><TR>";

############## Action REDIRECT 
		param("rules.forward.$rulecount","$sdest1");
		print "<TD $cb>&nbsp;</TD><TD $cb><input type=radio $check1 name=rules.desttype.$rulecount value=\"address\"> Forward To </TD><TD $cb>";
		print textfield("rules.forward.$rulecount",$sdest1,50)," (Email Address) </TD></TR><TR>";

############### Action REPLY WITH	
		if ($usereply) {

			param("rules.reply.$rulecount","$sdest2") if (defined $sdest2);
			print "<TD $cb>&nbsp;</TD><TD $cb valign=top><input type=radio $check2 name=rules.desttype.$rulecount value=\"reply\"> Reply With  </TD><TD $cb>";
			print textarea("rules.reply.$rulecount",$sdest2,2,43)," (Text Message) </TD></TR>";

		}
############## Action Reject  
	     if ($usereject) { 
	        	param("rules.reject.$rulecount","$sdest3");
		        print "<TD $cb>&nbsp;</TD><TD $cb valign=top><input type=radio $check3 name=rules.desttype.$rulecount value=\"reject\"> Reject </TD><TD $cb>";
		        print textarea("rules.reject.$rulecount",$sdest3,2,43)," (Text Message) </TD></TR>";
	     }
############## Action Discard  
	     if ($usediscard) { 
		        print "<TD $cb>&nbsp;</TD><TD $cb valign=top><input type=radio $check4 name=rules.desttype.$rulecount value=\"discard\"> Discard </TD><TD $cb>&nbsp;</TD></TR>";
	     }

############### Action CustomCode	
    	  if ($usecustom  ) {
	  	print "<TR>";	
		param("rules.custom.$rulecount","$sdest5") if (defined $sdest5);
		print "<TD $cb valign=top><b>OR</b></TD><TD $cb valign=top><input type=radio $check5 name=rules.desttype.$rulecount value=\"custom\">Custom Rule<br>(Sieve Script)</TD><TD $cb>";
		print textarea("rules.custom.$rulecount",$sdest5,5,52),"</TD></TR>";
#		print textfield("rules.forward.$rulecount",$sdest1,35),"</TD></TR><TR>";


          }

#### END of Actions
	
		$rulecount++;
	}

	print "</TABLE>";print "</TABLE</TD></TABLE>";
	print hr,"<TABLE ><TR><TD >$wild</TD></TABLE>";

	$rulecount--;
	print hr,"<center>",submit("Save Rule "),"&nbsp;&nbsp;",reset('Clear'),"</center>";

      } # if addrule

##### Forward all operation
    	  if ($op eq 'forward') {
		param("rules.priority.$rulecount","$spriority");
		param("rules.ruletype.$rulecount","ENABLED");
		param("rules.forward.$rulecount","$sdest1");
		param("rules.desttype.$rulecount",'address');
		param("rules.to.$rulecount",'');
		param("rules.from.$rulecount",'');
		param("rules.subject.$rulecount",'');
		param("rules.fieldname.$rulecount",'');
		param("rules.fieldval.$rulecount",'');
		# this prevents warnings further on	
		print hidden("rules.priority.$rulecount"),
		hidden("rules.ruletype.$rulecount"),
		hidden("rules.desttype.$rulecount"),
		hidden("rules.to.$rulecount"),
		hidden("rules.from.$rulecount"),
		hidden("rules.subject.$rulecount"),
		hidden("rules.fieldname.$rulecount"),
		hidden("rules.fieldval.$rulecount");

		print "</TABLE>";
		print hr, "<TABLE border=1 width=100%><TR $cb><TD $tb>";
   		print "<b><center>Forward all mail from:</b> $uid","</center></TD><TR $cb><TD><TABLE>";
		print "<TD $cb><b>Forward Mail To:</b> </TD><TD $cb>";
		print textfield("rules.forward.$rulecount",$sdest1,52);
		print "</TD></TR><TR><td></TD><TD $cb>";
		print "<b>NOTE: If you want to keep a copy of messages that ",
		"you are<br>forwarding, don't use this screen. Create a",
		" new filter rule to<br>redirect your mail instead.</b>";
		print "</TD></TR></TABLE></TABLE>";

	  }
	
	param('rulescount',$rulecount);
	print hidden('rulescount');


}


sub printinfo {
	my $percent='0.00';
	$percent= sprintf "%2.2d",$quota[1]/$quota[2]*100 if ($quota[2]);
	print "<center><TABLE border=1><TR $cb><TD><TABLE><TR>\n";
	print "<TD $cb><b>Server: </b>$imapserver</TD><TD $cb><b>Userid: </b>$uid</TD>"; 
	print "<TD $cb><b>Used Quota: </b>";
	if ($percent ne "" && ($havequota || !$useprocmail)) {
		print "[<b>$quota[1]</b> kbytes used /<b> $quota[2]</b> kbytes available.($percent\% usage)]</TD>";
	} else {
		print "<TD $cb><b>$quota[1]</b> No limits</TD>";
	};
	if ($usemulti && !$useprocmail) {
		print "<TD $cb><b>Script: </b>[$viewscript]</TD>"
	}

	print "</TD></TABLE></TABLE></center>";
	
}

sub byline
{ 
	return if $nobyline;
	print "<p><br><CENTER><b>Websieve</b><br>";
	print "Mail Account Management Tool Version: $version<br>Written by: Alain Turbide<br>";
      print '<ADDRESS><A HREF=mailto:aturbide@toshiba.ca>aturbide@toshiba.ca</A></ADDRESS></CENTER></p>';

	return;
}

sub incorrect_login
{
	print start_html(-title=>'Login Error!',-BGCOLOR=>'yellow'),
		h2('Login Error'),
		"There was an error in loging you in to the server.  Please ",
		"click <a href=" . $program_url . "?op=login>HERE</a> and try again.\n";
	if ($error !~ /sieve/i) {
		print "<p><b>System Error: </b>$error";
		print "<br>User server=$userserver<br>";
	}
	else {
		print "<p><h> Wrong Password! </b>";
	}
	print end_html;
	exit;
	
}

sub web_authenticate
{
	my @slist=@serverlist;
	my %serverdisplay;
	while ($_=shift @slist) {
		$serverdisplay{$_}=$server_hosts{$_}[0] if $_;
	}


	print start_html(-title=>$header1,-BGCOLOR=>$bg),
		"<BR><CENTER>",h1($header1),
		"For Problems with this service, please email <a href=mailto:$problem_email>$problem_email</a><br>",$HOMEURL,"<br>",
		start_form,"<TABLE border=1><TR $cb><TD><TABLE>",
	
	 	"<TR><TD $cb>","<b>Login: </b> </TD><TD $cb>",textfield('login'),"</TD>",
		"<TR><TD $cb><b>Password:  </b></TD><TD $cb>",password_field('password'),"</TD>";

		if ($useserverselect) {
		print "<TR><TD $cb><b>Mail Server:  </b></TD><TD $cb>",popup_menu("server",[@serverlist],$imapserver,\%serverdisplay);
		}
	
		print "</TABLE></TD></TABLE>",br,
		
		submit('Login'),"</CENTER>",
		hidden('op');
	print "<CENTER>Your \"Login\" is the same as the part of your e-mail<BR>address that goes before the \@ symbol.</CENTER>";

		print end_form;
}

sub bind
{
	  &openimap($uid,$pass,$imapserver,$imapport,$useimapSSL,$unixhiersep);
	  if (!$imap || $IMAPERROR=~/NO login/i) {
		$error=$IMAPERROR."<br>";
               &closeimap;
               return -1;  # Return Failure
	  }

	  if (!$useprocmail) {
  	      &opensieve($uid,$pass,$sieveport,$imapserver,$usesieveSSL);
	      if (!$sieve || $SIEVEERROR) {
	  	$error.=$SIEVEERROR."<br>";
		&closeimap;
		&closesieve;
		return -1;
	      }
	  } 
	  return 0;  # Return Success
}

sub modify_screen
{
#  Print WWW Header
	my $header2="Mail Server: $userserver" if $showserver;
	$header2=" " if !$header2;
	my $err;
       print start_html(-title=>"$header1 for '$uid' on $userserver",-BGCOLOR=>$bg, -LINK=>"black", -VLINK=>"black"),
        "<CENTER>",h2("$header1 $header2"),"</CENTER>";

	%scripts=&getuserinfo;
	$mode=$scripts{'mode'};
	$op='';
	$op=param('op') if param('op');

	if ($mode =~ /advanced/i && !$op) {
		$op = 'viewrules';
	}
	if ($showmenu||$showhome) {
		print "<table align=center size=70%><tr><td>",tablebutton($HOMEURL);
		print "</TD><td>",tablebutton($LOGOUTURL),"</td>";
		if ($useldapextras) {
			print "<td>",tablebutton($LDAPSEARCHURL),"</td>";
			if ($ismanager) {
				print "<td>",tablebutton($NEWUSERURL),"</td>";
				print "<td>",tablebutton($NEWGROUPURL),"</td>";
				$showmenu = $mgrrecmail;
			}
		}
	}
	print "</tr></table>";
	print "<center><table align=center><tr>";
	print "<td>",tablebutton($SETPASSWORDURL),"</td>" if $useauth;
	print "<td>",tablebutton($SETVACATIONURL),"</td>" if ($usevacation && $mode ne 'advanced');
	print "<td>",tablebutton($FORWARDALLURL),"</td>" if ($useforwardall && $mode ne 'advanced');
	print "<td>",tablebutton($VIEWRULESURL),"</td>";
	print "<td>",tablebutton($ADDRULEURL),"</td>" if ($mode ne 'advanced');
	if ($useacl && !$ismanager) {
		print "<td>",tablebutton($SETACLURL),"</td>" ;
	}
	elsif ($ismanager) {
		print "<td>",tablebutton($ADMINMENUURL),"</td>";
	}
	print "<td>",tablebutton($ADVANCEDURL),"</td>" if ($allowadvanced || $usemulti);
	print "</center></tr></table>";
	&printinfo;

#  Draw up the Web Form
	print start_form(-action=>$program_url);
	$gomodifyit = 'yes';
	 print hidden('s',$sencode_params) if $useservercookie;
	 print "<center>",submit('Save Changes'),"&nbsp;&nbsp;",submit("Refresh"),"&nbsp;&nbsp;",reset('Reset Values'),"</center>" if $op;
	param('op',$op);
	if (param('action') && param('action') eq 'deletembx') {
		&deleteimapmailbox;
	}
	#Call ldapextras functons if configured to do so
	$res = &ldapextras if ($useldapextras);
	print hidden('gomodifyit',$gomodifyit);
	if (param('gomodifyit'))
	{
	   &gomodifyit;
	   %scripts=&getuserinfo;
	}
	if ($op eq 'addrule' && $returntoview) {	
		param('op','viewrules');
	}
	print hidden('op');
	&initscripts(%scripts);
	if ($op eq 'setacl') {
	 	&viewacl if $useacl;
		print "<hr><center>",submit('Save Changes'),"&nbsp;&nbsp;",submit("Refresh"),"&nbsp;&nbsp;",reset('Reset Values'),"</center>";

	}
	if ($mode =~ /basic/i && $op ne 'setacl') {
		&printrules if ($op eq 'addrule' || $op eq 'viewrules' || $op eq 'forward');
		if ($op eq 'setvacation') {
	        	&printvacation if $usevacation;
		}
	}
	elsif (($op ne 'setpass' && $op ne 'setacl' && $op eq 'viewrules' && $op ne 'forward')  ) {
#		print "printing $op<br>";

		&printscript($scripts{'script'}) ;
	print "<hr><center>",submit('Save Changes'),"&nbsp;&nbsp;",submit("Refresh"),"&nbsp;&nbsp;",reset('Reset Values'),"</center>";


	}
	if ($op eq 'setpass') {
		print hr;
		&printpass if $useauth;
	}


	#print "</TABLE>";
	end_form;
	return;
}


sub checkrules {
        my ($linecount,$destt,$priority,$rulecount,$linecount2,@rulelist,$oldrules,$onerule,$copyflg,$sizeflg,$keepflg,$size);
	$copyflg='';
	$dest='';
	$linecount=$rulecount=0;

	$delimiter='&&';
	$dest="";
	my (@rulea,@tmprules);

	$linecount2=param("rulescount");	
	
	@tmprules=@rules;
        # start of current rule check
        # only priority and ruletype can be changed here

	if (!defined $linecount2) {
		$rules=join("\n",@tmprules);
		return ($rules);
	}
	$rulesorig='';
	while (@tmprules) {
		$line=shift(@tmprules);
                $rulesorig.=$line;
		chomp($line);
		$line=~s/^ +//;
		$line=~s/ +$//;
		
		($priority,$ruletype,$from,$to,$subject,$destt,$dest,$flg,$fieldname,$fieldval,$size)=split('&&',$line);
		if ($flg=~/copy/i) {
			$flg=$copybit;
		}
		$size='' if !$size;
		$flg=0 if !$flg;
		$copyflg=($flg & $copybit);
		$sizeflg=($flg & $sizebit);
		$keepflg=($flg & $keepbit);
		my ($pruletype)="";
		$pruletype=param("rules.ruletype.$linecount") if param("rules.ruletype.$linecount");
                # if delete or not valid data in fields, skip rule (delete it)
#		if (($pruletype=~/^delete/i) || ($ruletype=~/delete/i) || (!($to || $from || $subject ||  $size || ($fieldname && $fieldval) || $pruletype)) ) {
#			$linecount++;
#			next;
#		
#		}
		if ($pruletype=~/^delete/i || $ruletype=~/delete/i ) {
			$linecount++;
			next;
		}
		my ($pr1,$rt1)="";
		if (defined(param("rules.priority.$linecount"))) {

                	$pr1 =param("rules.priority.$linecount");
                	$rt1 =param("rules.ruletype.$linecount");
		}
		else {
			$rt1=$ruletype;
			$pr1 =$priority;
		}

                $rt1=~s/ +//g;
                $pr1=~s/ +//g;
		$size=~/([0-9kK]+)/;
		$size=$1;
		$size='' if !$size;
                #check for valid data passed in form (ruletype and priority)
                #if not use original values from saved script

                if (($pr1!~/\W+/) && ($pr1=~/\d+/)) {
                        $priority=$pr1;    
		}
		#check for valid ruletype passed in form 
                
		#print "rt1=$rt1, ruletype=$ruletype<br>";
		if ($rt1=~/\W+/ ) {
			$rtype=$ruletype;
		}
		else {
                        $rtype=$rt1;

		}
		if (!$rtype) {
                        $rtype="DISABLED";
		}
		$rule=$priority.$delimiter.$rtype.$delimiter.$from.$delimiter.$to.$delimiter.$subject.$delimiter.$destt.$delimiter.$dest.$delimiter.$flg.$delimiter.$fieldname.$delimiter.$fieldval.$delimiter.$size."\n";

                # save checked rule  and increment linecount 
		push (@rulea,$rule);
		$linecount++;

	} # while

	$linecount=param("rulescount");
# start checking new rule entry for validity and parse it
# New or modified rule is checked here
# this loop should only run once

	while ($linecount==param("rulescount")){
                # check for valid data - else skip rule
		if (!param("rules.to.$linecount") && !param("rules.from.$linecount") && !param("rules.subject.$linecount") && !(param("rules.fieldname.$linecount") && param("rules.fieldval.$linecount")) && !param("rules.size.$linecount") && !param("rules.custom.$linecount") && !param("rules.forward.$linecount") && !param("rules.ruletype.$linecount")) {

			$linecount++;
			next;
		} 		
		$destt=param("rules.desttype.$linecount");
		if ($destt=~/folder/i) {
			if(param("rules.mailbox.$linecount")!~/\S/) {
				$linecount++;
				next;
			}
			$dest=param("rules.mailbox.$linecount");
			 
		}
		elsif ($destt=~/address/i) {
			if(param("rules.forward.$linecount")!~/\S/) {
				$linecount++;
				next;
			}
			$dest=param("rules.forward.$linecount");
		}
		elsif ($destt=~/reply/i) {
			if(param("rules.reply.$linecount")!~/\S/) {
				$linecount++;
				next;
			}
			$dest=param("rules.reply.$linecount");
                        $dest=~s/\n/\\n/g;
			$dest=~s/\r//g;
		}
		elsif ($destt=~/custom/i) {
			if(param("rules.custom.$linecount")!~/\S/) {
				$linecount++;
				next;
			}
			$dest=param("rules.custom.$linecount");
                        $dest=~s/\n/\\n/g;
			$dest=~s/\r//g;
		}

		elsif ($destt=~/reject/i) {
			if(param("rules.reject.$linecount")!~/\S/) {
				$linecount++;
				next;
			}
			$dest=param("rules.reject.$linecount");
                        $dest=~s/\n/\\n/g;
			$dest=~s/\r//g;
		}

		else {
			$dest='';
		}
		$copyflg='';
		$keepflg='';
#		$copyflg=param("rules.copy.$linecount");
		my @checked=param("rules.copy.$linecount");
		$copyflg=$copybit if (grep /copy/i, @checked);
		$keepflg=$keepbit if (grep /keep/i, @checked);
		$regexflg=$regexbit if (grep /regex/i,@checked);

#		$regexflg=param("rules.regex.$linecount");
		if (param("rules.sizeflg.$linecount")) {
			$sizeflg=$sizebit;
		} else {
			$sizeflg=0;
		}
	

		if (param("rules.searchflg.$linecount")) {
			$searchflg=$searchbit;
		}
		else {
			$searchflg=0;
		}
		if (!$sizeflg) {$sizeflg=0};
		if (!$copyflg) {$copyflg=0};	
		if (!$regexflg) {$regexflg=0};
		if (!$keepflg) {$keepflg=0};

		$flg=$keepflg | $copyflg | $searchflg | $regexflg | $sizeflg; # OR other flgs here
                $onerule=param("rules.priority.$linecount").$delimiter."ENABLED".$delimiter.param("rules.from.$linecount").$delimiter.param("rules.to.$linecount").$delimiter.param("rules.subject.$linecount").$delimiter.
param("rules.desttype.$linecount").$delimiter.$dest.$delimiter.$flg.$delimiter.param("rules.fieldname.$linecount").$delimiter.param("rules.fieldval.$linecount").$delimiter.param("rules.size.$linecount")."\n";
		$linecount++;
	}#while
        push (@rulea,$onerule) if $onerule;
	@rulea=sort {($a=~/(\d+)/)[0] <=>  ($b=~/(\d+)/)[0]} @rulea;
	$rulelist="@rulea";
        if ($rulesorig ne $rulelist) {
		return $rulelist;	
	}
		
	return "";
}

sub checkvacation {
	my (@tmp,$tmp,$t1,$t2);

	if (!defined param('vacationmode')) {
		$tmp=$vacation{'addresses'};	
	}
	else {
        	$vacation{'days'}=param('vacationdays');
		$tmp=param('vacaddresses');
		$vacation{'mode'}=param('vacationmode');
       		$vacation{'text'}=param('vacationtext');
		

	}
	$tmp=~s/\"//g;
	$tmp=~s/\@/\\@/g;
	$tmp=~s/\r//g;
 	$tmp=~s/,+|:+|;+|\n/ /g;
	$tmp=~s/ +/ /g;
		
	$vacation{'addresses'}=$tmp;
	if ($vacation{'addresses'}) {
		$vacation{'addresses'}=~s/\\@/\@/g;
		@tmp=split(",| +",$vacation{'addresses'});
		
		while (@tmp) {
			$t1.=', ' if $t1;
			$t1.="\"".shift(@tmp)."\"";
		}
		$vacation{'addresses'}=$t1 if $t1;
	}	
	

	$vacation{'addresses'}="\"$uid\@$maildomain\", \"$uid\@$mailhostappend\"" if ($vacation{'addresses'}!~/\w+/);
	$vacation{'days'}="1" if ($vacation{'days'}!~/\d/);
        return;
}



sub gomodifyit
{
my (%tmpscr,$mode,@pseudo,$tmp,$modchange,$pseudonew,$delete,$save,$pseudo,$err);
	
# process the sieve or procmail pseudo rulesets
	$change=0;
	$err='';
	if (param('Refresh')) {
		print "Screen Refreshed";
		return;
	}
        %tmpscr=%scripts;
	$oldscript=$tmpscr{'script'};
	$scriptname=$tmpscr{'scriptname'};
	$scriptdef=$tmpscr{'scriptdef'};
	$script=param('script');
	$oldmode=$tmpscr{'oldmode'};
	$mode=param('mode');
	$pseudo=$tmpscr{'pseudo'};
	$delete=$tmpscr{'deletescript'};
	# from auth.pl	
	$res.=&auth_changepass if $useauth;
	return if $op eq 'setpass';
	&modifyacl if ($useacl && $op eq 'setacl');
	return if $op eq 'setacl';
	print hr;
	if ($delete && !$useprocmail) {
		&opensieve($uid,$pass,$sieveport,$imapserver) if !$sieve;
		if ($scriptdef!~/yes|on|active/i && $viewscript eq $scripts{'active'}) {
		$res.=&setactive("");
 		}

		$res.=&deletescript($delete);
		if ($res) {
	      		print "\n",br,"<b>Delete Script Error:</b> $res...\n",br;
			return;
	 	}
		return;	
	}
	if ($scriptdef!~/yes|on|active/i && $viewscript eq $scripts{'active'} && !$useprocmail) {
		$res.=&setactive("");
 	}

	&checkvacation if ($usevacation || $usereply);
	if (($oldmode ne $mode) && (param('viewscript') eq param('lastviewscr'))) {
			$modchange=1;
			print "<b>Warning! Now in $mode mode...<br></b>" if $mode;
			print "<b>Any changes made in advanced mode have now been overwritten.<br></b>" if $mode eq 'basic';
			print "<b>If you switch from advanced mode to basic you will lose any changes made to this script. </b><br>" if $mode eq 'advanced'
		}
#print "mode=$mode oldmode=$oldmode<br>";
	 # check if viewing new script - no save then
       if (param('viewscript') eq param('lastviewscr')) {	
	if ($mode =~ /basic/i || $modchange) {
		
		$rules=&checkrules;
		if ($useprocmail) { 
			my $prules;
			my @rules=split(/\n/,$rules);
			while ($_=shift(@rules)) {
				$prules.="#rule&&".$_."\n";
			}
			$change=1;
			my $vtext=$vacation{'text'};
			$vtext=~s/\n/\\n/g;
			$vtext=~s/\r//g;
			
			$prules.="#vacation&&".$vacation{'days'}."&&".$vacation{'addresses'}."&&".$vtext."&&".$vacation{'mode'}."\n"; 
			$prules.="#mode&&basic\n";
			 &auth_saveattrib($matchingrules,$prules) if defined &auth_saveattrib; 
			 &mailruleupd($uid);
			 
                  } 
		   elsif ($res.=&updatesieve($rules,%tmpscr)) {
		      print "\n",br,"<b>Updatesieve Error:</b> Cant' update script...",br;
	      print "<b>Returned Error:</b> $res $SIEVEERROR<br>";	
	      print "You can click on your browser's  <b>Back</b> button to ";
		      print "go back and try your entry again.<br>";
#		      return;
			print hr;
			&byline;
			exit;
			
		   }
	}
	else {
		$script=$oldscript if (!$script && $scriptdef !~/yes|on|active/i);

		if ($script && ($script=~/\w+/) && ($scriptname))  {
			@pseudo=split("\n",$pseudo);
			while (@pseudo) {
				$tmp=shift(@pseudo);
				$tmp=~s/^ *#mode.*$//ig;
				next if ($tmp!~/\S/);
				$pseudonew.=$tmp."\n";
						
			}
			$vacation{'text'}=~s/\n/\\n/g;
			$vacation{'text'}=~s/\r//g;
			$pseudonew.="\n#mode&&advanced\n";
			if (($script ne $oldscript) || ($pseudo ne $pseudonew) || ($scriptname ne $tmpscr{'viewscript'}) || $mode ne $oldmode) {	
				$change=1;
				&opensieve($uid,$pass,$sieveport,$imapserver) if !$sieve;
				#$script.="\n".$pseudonew;
				$script=~s/\r\n/\n/mg;
				$res.=&putscript($scriptname,$script);
				$res.=&putscript($scriptname."_pseudo",$pseudonew);
				
			}
		
	      } # if script =~/\w
		if ($scriptdef=~/yes|on|active/i && $scriptname && !$useprocmail) {
			&opensieve($uid,$pass,$sieveport,$imapserver) if !$sieve;
               		$res.=&setactive($scriptname);
			print "Script $scriptname now active.. <br>";

	       	}
		
	}
       } # if param(viewscript)	
       else {
		param('scriptdef','off');
	}
#  Success!
        if (!$res ) {
                print "<b>Update successful...</b>" if $change;
		print "<b>No changes..</b>" if !$change;
                return;
	}
        else {
            print "<b>Failure<br>Returned Error:</b> $res <br>";
	     return;

	}
}


sub updatesieve {
        my ($filterval,%scripts) =@_;
	$scriptdef=$scripts{'scriptdef'};
	$scriptname=$scripts{'scriptname'};
	if (!$scriptname) {
		$scriptname=$scripts{'viewscript'};
	}
	my (@mbxlist,$rulesyes,$vacationyes,$usereject);
my %fields=(
	"subject",'"subject" ',
	"to",'["Cc","CC","To","TO"] ',
 	"contain",':contains ',	
	"from",'["from"] ',
	"address",'redirect ',
	"folder",'fileinto ',
	"reject",'reject ',
	"reply",'vacation :days '.$vacation{'days'}.' ',
	"discard",'discard '
	
	);
	my %matchtype=(
		"0","allof",
		$searchbit,"anyof"
		);
 	
#	$fields{'contain'}=':matches ' if ($usematches);	
        my (@lrules)=split('\n',$filterval);
	my ($keep,$copyrules,$copystat,$procreq,$procr,$extradefs) = "";
	my $proch="";	
	my $proc="";
	my $not="";
	$copystat="";	
	$usereject=0;
	$procr="";
	$copyrules="";
	$procreq="";
	$rulesyes=0;
	$vacationyes=0;
	my ($fieldn,$field,$wc);
	my $regexused;
	my $noelse;
        while (@lrules) { 
		my $tmp='';
                $line=shift(@lrules);
		chomp($line);
		my ($priority,$ruletype,$from,$to,$subject,$desttype,$dest,$flg,$fieldname,$fieldval,$size) = split("&&",$line);
		next if !$desttype;
		$procr.="#rule&&"."$line\n";
		$dest=~s/\r//g;
		$dest=~s/\\n/\r\n/g;
		if ($flg=~/copy/i) {
			$copyflg=$copybit;
		} 
		else {
			$copyflg= ($flg & $copybit);
		}
		$keep="";	
		$matchflg=($flg & $searchbit);
		$keepflg=($flg & $keepbit);
		$keepflg=0 if (!$keepflg);
		$matchflg=0 if (!$matchflg);
		$sizeflg=($flg & $sizebit);
		$sizeflg=0 if (!$sizeflg);	
		$regexflg=($flg & $regexbit);
		$regexused ||=$regexflg;
#		if ((!($to|$from|$subject|($fieldname && $fieldval)) | !$fields{$desttype}) && (!($dest && $desttype eq 'custom')) && !$dest) {next};
		if ($ruletype !~/ENABLED|\d/i) {next};
		$keep="     keep;\n" if $keepflg;
	     	if ($desttype=~/folder/i) {
			#@mbxlist=&listmailbox("user.$uid.$dest");
			#if (!@mbxlist) {	
			#	print "Folder $uid.$dest does not exist ..\n";
			#	next};
			next if !$dest;
			$dest=~s/^INBOX.INBOX/INBOX/;
			if (($dest =~/^INBOX/)||($alt_namespace)) {
				$msgdest=$dest;
			}
			else   {
				$msgdest="INBOX.$dest";
			}
			# check if folder is in an addtional namespace
			foreach $namespace (@namespaces) {
				if ($dest=~/^$namespace./i) {
					$msgdest="$dest";
					last; # stop checking
				}
			}
		}
		elsif ($desttype=~/address|reply|reject/i) {
			$msgdest=$dest;
			if ($desttype=~/address/i && $dest!~/\w+\@\w+\.\w+/) {
				next;
			}
			$usereject=1 if $desttype=~/reject/i;
			$vacationyes=1 if $desttype=~/reply/i;
			if (($keepredirect ) && ($desttype=~/address/i)) {
				$keep="     keep;\n";
			}
			next if !$dest;

		}
		else {$msgdest='';}
		$rulesyes=1;	
			
		if ($copyflg==$copybit) {
			$copystat='';
		}
		else {
			$copyflg='';
		}
		$fieldn='0';
		$field='';	
		$wc='';
		$fields{'contain'}=':matches ' if ($usematches);	
		$not='';

		if ($to) {
		    if ($regexflg) {
		    	$fields{'contain'}=':regex ';
			$wc='';
		    }
		    else {

			if ($to=~/\*|\?/) {
				$fields{'contain'}=':matches ';
				$wc='*' if (!$usematches);
			}	
			elsif (!$usematches) {
				$fields{'contain'}=':contains ';
				$wc='';
			}
		    }
			$not="not " if $to=~s/^\s*!//;
			$field.=$not."address ".$fields{'contain'}.$fields{'to'}."\"$wc$to$wc\"";
			$fieldn++;
		}
		$not='';
		if ($from) {
		    if ($regexflg) {
		    	$fields{'contain'}=':regex ';
			$wc='';
		    }
		    else {

			if ($from=~/\*|\?/) {
				$fields{'contain'}=':matches ';
				$wc='*' if (!$usematches);
			}	
			elsif (!$usematches) {
				$fields{'contain'}=':contains ';
				$wc='';
			}

		    }

			$not="not " if $from=~s/^\s*!//;
			
			if ($field) {$field.=", ";}
			$field.=$not."address ".$fields{'contain'}.$fields{'from'}."\"$wc$from$wc\"";

			$fieldn++;
				
		}
		$not='';
		if ($subject) {
		    if ($regexflg) {
		    	$fields{'contain'}=':regex ';
			$wc='';
		    }
		    else {

			if ($subject=~/\*|\?/) {
				$fields{'contain'}=':matches ';
				$wc='*' if (!$usematches);
			}	
			elsif (!$usematches) {
				$fields{'contain'}=':contains ';
				$wc='';
			}		
		    
		    }	

			$not="not " if $subject=~s/^\s*!//;
			
			if ($field) {$field.=", ";}
			$field.=$not."header ".$fields{'contain'}.$fields{'subject'}."\"$wc$subject$wc\"";
			$fieldn++;
			
		}
		$not='';
		if ($size) {
		    	$fields{'contain'}=':under ';
		    	$fields{'contain'}=':over ' if $sizeflg;
			$not="not " if $size=~s/^\s*!//;
			my $kb='K';
			$kb='K' if $size=~s/k//gi; 
			$size=~/([0-9]+)/;
			$size=$1;
			$size='' if !$size;
			if ($field) {$field.=", ";}
			$field.=$not."size ".$fields{'contain'}.$size.$kb;
			$fieldn++;
		}
		
		$not='';
		if ($fieldname && $fieldval) {
		    if ($regexflg) {
		    	$fields{'contain'}=':regex ';
			$wc='';
		    }
		    else {
			if ($fieldval=~/\*|\?/) {
				$fields{'contain'}=':matches ';
				$wc='*' if (!$usematches);
			}	
			elsif (!$usematches) {
				$fields{'contain'}=':contains ';
				$wc='';
			}

		    }			
			$not="not " if $fieldval=~s/^\s*!//;
			
			if ($field) {$field.=", ";}
			$field.=$not."header ".$fields{'contain'}." \"".$fieldname."\""." \"$wc$fieldval$wc\"";

			$fieldn++;
				
		}
		
		if ($desttype=~/reply/i) {
			$extradefs=":addresses [$vacation{'addresses'}] ";
		}
		else { $extradefs="";}

		if ($desttype=~/reply|reject/i) {
			$msgdest="text:\r\n".$msgdest."\r\n\.\r\n" if $msgdest;
		}
		else {
			$msgdest="\"".$msgdest."\"" if $msgdest;
		}
#		print "copystat=$copystat matchtype=$matchtype{$matchflg} fields=$field fields2=$fields{lc($desttype)} extra=$extradefs msgdest=$msgdest keep=$keep<br>";
		if (!($to || $from || $subject || $size || $fieldname || $fieldval ) && $desttype ne 'custom') {
			$tmp=$fields{lc($desttype)}.$extradefs.$msgdest.";\n$keep\n\n" if ($desttype && $msgdest);
			$noelse=1;
			$copystat='';
			$copyflg=$copybit;
		}
		elsif ($desttype eq 'custom') {
			$tmp=$dest."\n\n";
			if ($tmp!~s/^\s*if /if /i && $tmp!~s/^\s*elsif /if /i) {
				$noelse=1;
				$copyflg=$copybit;
			}
			else {
				$tmp=$copystat.$tmp;
				$noelse='';
			}
				
		}
		else {
			$copystat='' if ($noelse || $copyflg);
			$tmp=$copystat."if ".$matchtype{$matchflg}." \($field\) {\n     ".$fields{lc($desttype)}.$extradefs.$msgdest.";\n$keep}\n\n";	
			$noelse='';
		}
#		print $proc;

		if (!$copyflg)  {
			$proc.=$tmp;
		}
		else {
			$copyrules.=$tmp;
		}
		$copystat='els' if $proc;
		$change=1;
	} #while @lrules
	$vacationyes=1 if ($vacation{'mode'}=~/on|active|yes|1/i);
	$proch="# Mail rules for user $uid\n# Created by Websieve version $version\n";
	if ($rulesyes | $vacationyes | $usereject | $regexused) {
		
	
		$procreq="require [\"fileinto\"";
	
		if ($vacationyes) {

			$procreq.=",\"vacation\"";
		}	
		if ($usereject) {
			$procreq.=",\"reject\"";
	
		}	
		if ($regexused) {
			$procreq.=",\"regex\"";
		}
		$procreq.="];\n\n";
	}
	
	
	$proc=$proch.$procreq.$copyrules.$proc;
	$proc.="else {\n     keep;\n}\n\n" if ($rulesyes && !($op eq 'forward') && !$noelse) ;

	if($vacation{'mode'}=~/on|active|yes|1/i) {
		# this forces the script active when vacation is on
		$scriptdef='on' if $mode ne 'advanced';
#		print "vacation=".$vacation{'text'}."<br>";
		$vacation{'text'}=~s/\\n/\r\n/g;	
       		 $vacation{'addresses'}=~s/\n/,/g;
		 if ($vacation{'text'} && $vacation{'days'}) {
#			print "Sieve vacation active<br>";
#			print "\nvacation :days ".$vacation{'days'}." :addresses [".$vacation{'addresses'}."] "."text:\r\n".$vacation_prelude.$vacation{'text'}."\r\n\.\r\n".";\n";
			
			$proc.="\nvacation :days ".$vacation{'days'}." :addresses [".$vacation{'addresses'}."] "."text:\r\n".$vacation_prelude.$vacation{'text'}."\r\n\.\r\n".";\n";
		
			$rulesyes=1;
   		}
		else {
			$vacation{'mode'}='off';
		}
	
	}
	if (!$rulesyes ) { 
                $proc=$proch;
		$rulesyes=1;
        }
		
        
	$change=1;
	if ($rulesyes) {
		&opensieve($uid,$pass,$sieveport,$imapserver) if !$sieve;
		$pseudo.="\n\n##PSEUDO script start\n".$procr; # append #rule lines to end of script 
		# append vacation pseudo lines
		$vacation{'text'}=~s/\n/\\n/g;	
	#	$vacation{'addresses'}=~s/\"//g;
		$vacation{'text'}=~s/\r//g;
		$pseudo.="#vacation&&".$vacation{'days'}."&&".$vacation{'addresses'}."&&".$vacation{'text'}."&&".$vacation{'mode'}."\n" if $usevacation; 
		$pseudo.="#mode&&$mode\n";
		&auth_saveattrib($matchingrules,$pseudo) if ($updatepseudo && defined &auth_saveattrib); 
		
		#$proc.=$pseudo;
		#print "name=$scriptname<br>proc=$proc"; # debug
#		&savetext($scriptname,$proc);	 # debug test
		&putscript($scriptname,$proc);
		if (&putscript($scriptname."_pseudo",$pseudo)) {
		    if ($SIEVEERROR =~ /exist/i) {
		    		return '';
		    }
		    else {
		    	return $SIEVEERROR;
		    }
                        
                }
		if($vacation{'mode'}=~/on|active|yes|1/i) {
			print "Sieve vacation active<br>";
		}

		if ($scriptdef && $scriptdef=~/yes|on|active/i && !$useprocmail) {
			print "Script $scriptname active.. <br>";
               		$res=&setactive($scriptname);
			return $SIEVEERROR if $res;
	       }
	      
	       return;
        } # if rulesyes

}

sub printvacation {
	my ($tmpvacadd);
	
	$tmpvacadd=$vacation{'addresses'};
     %modevals = (
	"on","Yes",
	"off","No");
	$vacation{'text'}=~s/\\n/\r\n/g;
	
	
    			print hr,"<TABLE border=1 width=100%><TR $cb><TD $tb>";
   			print "<b><center>Vacation Mode status for:</b> $uid","</center></TD><TR $cb><TD>";
			
			print "<TABLE>";                    
                        param("vacationmode",$vacation{'mode'});
                        print "<TR><TD $cb><b>Vacation Active?:</b></TD> <TD $cb>",radio_group("vacationmode",['off','on'],$vacation{'mode'},'',\%modevals),"</TD></TR>\n";
                        param("vacationtext",$vacation{'text'});
                        print "<TR><TD $cb valign=top><b>Vacation Text:</b></TD> <TD $cb VALIGN=TOP>",textarea("vacationtext",$vacation{'text'},5,50,"","wrap=virtual"),"</TD></TR>\n";
		      if (!$useprocmail) {
                        param("vacationdays",$vacation{'days'});
                        print "<TR><TD $cb><b>Repeat Days:</b></TD> <TD $cb VALIGN=TOP>",textfield("vacationdays",$vacation{'days'},2,"")," (How many days before sending vacation notice again in reply to same user.)</TD></TR>\n";
                        param("vacaddresses",$tmpvacadd);
                        print "<TR><TD $cb><b>Vacation Addresses:</b></TD> <TD $cb VALIGN=TOP>",textarea("vacaddresses",$tmpvacadd,2,50,"","wrap=virtual")," (Your email addresses that you receive mail on)</TD></TR>\n";
		      } # if !$useprocmail
print "</TD></TABLE></TABLE>";
}


sub createmailfolder {
	my ($mbx,$partition)=@_;
	my @list=&listmailbox($mbx);
	my $err;
	if (!(@list)) {
	  $err=&createmailbox($mbx,$partition);
	}
	else {
		$err="$mbx already exists!";
	}
	if ($err) {
		return $err;
	}
	print "$mbx created successfully. <br>";
	 return "";
}
	
#############################################
 sub encode_list {
      return undef unless @_;
      my $out='';
      foreach (@_) {
         $out .= 'G'.pack('c', 65 + int(rand(6))) if $out;
         $out .= reverse(uc(unpack('H'.(length)*2, $_))) if $_;
      }
      return $out.'='; # looks like some recognizable format
 }

 sub decode_list {
     return undef unless $_[0];
     my @out;
     foreach ( split(/G[A-F]/, substr($_[0],0,-1)) ) {
         push @out, pack('H'.(length), scalar reverse $_);
     }
      return @out;
 }

 	
##############################################

# Encryption routines for cookie

# from EZCrypt v2.0 (c) 2000 Croesus Design and Promotion
# Developed by Jason C. Fleming
# Base64 routines Copyright 1995-1997 Gisle Aas.
# This library is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

sub Encrypt {
my ($plaintext,$key) = @_; #get message and key from user 
    if (!$key) { 
    	print "\$skey not set!!! <br>";
    }
    my ($cr,$index,$char,$key_char,$encrypted);
    $plaintext = &rot13($plaintext); #garble source by swapping alphabet
    $cr = '``'; #carriage return character unlikely to occur in text
    $plaintext =~ s/[\n\f\t]//g; #remove whitespace chars
    $plaintext =~ s/[\r]/$cr/g; #swap cr with our token
    while ( length($key) < length($plaintext) ) { $key .= $key } #pad private key
    $key=substr($key,0,length($plaintext)); #set key to same length as source
    $index=0;
    while ($index < length($plaintext)) { #go through each character and swap bits with key
        $char = substr($plaintext,$index,1);
        $key_char = substr($key,$index,1);
        $encrypted .= chr(ord($char) ^ ord($key_char)); #THE MEAT OF THE ENCRYPTION
        $index++;
    }
    $encrypted = encode_base64($encrypted); #convert xor encrypted string into printable blocks
    $encrypted; #send the cyphertext back to user
}

sub Decrypt {
    my ($encrypted, $key) = @_;
    $encrypted = decode_base64($encrypted); #convert encrypted blocks into xor code
    my ($cr,$index,$char,$key_char,$decrypted);
    while ( length($key) < length($encrypted) ) { $key .= $key } #pad key
    $key=substr($key,0,length($encrypted)); #set key to same length as source
    $index=0;
    while( $index < length($encrypted) ) { #swap bits with key
        $char = substr($encrypted,$index,1);
        $key_char = substr($key,$index,1);
        $decrypted .= chr(ord($char) ^ ord($key_char)); #THE MEAT OF THE ENCRYPTION
        $index++;
    }
    $cr = '``'; 
    $decrypted =~ s/$cr/\r/g;#replace carriage returns
    my $list=&rot13( $decrypted ); #unswap alphabet
    
}

sub rot13{ #swaps low letters (a-m) with high letters (n-z) and visa versa
    my $source = shift (@_);
    $source =~ tr /[a-m][n-z]/[n-z][a-m]/; #performs rot13 swapping (lc)
    $source =~ tr /[A-M][N-Z]/[N-Z][A-M]/;#performs rot13 swapping (caps)
    $source = reverse($source);
    $source;
}

sub encode_base64 {
    my $res = "";
    my $eol = $_[1];
    $eol = "\n" unless defined $eol;
    pos($_[0]) = 0;                          # ensure start at the beginning
    while ($_[0] =~ /(.{1,45})/gs) {
    $res .= substr(pack('u', $1), 1);
    chop($res);
    }
    $res =~ tr|` -_|AA-Za-z0-9+/|;               # `# help emacs
    # fix padding at the end
    my $padding = (3 - length($_[0]) % 3) % 3;
    $res =~ s/.{$padding}$/'=' x $padding/e if $padding;
    # break encoded string into lines of no more than 76 characters each
    if (length $eol) {
    $res =~ s/(.{1,76})/$1$eol/g;
    }
    $res;
}

sub decode_base64{
    local($^W) = 0; # unpack("u",...) gives bogus warning in 5.00[123]

    my $str = shift;
    my $res = "";

    $str =~ tr|A-Za-z0-9+=/||cd;            # remove non-base64 chars
    #if (length($str) % 4) {die "Base64 decoder requires string length to be a multiple of 4"}
    $str =~ s/=+$//;                        # remove padding
    $str =~ tr|A-Za-z0-9+/| -_|;            # convert to uuencoded format
    while ($str =~ /(.{1,60})/gs) {
    my $len = chr(32 + length($1)*3/4); # compute length byte
    $res .= unpack("u", $len . $1 );    # uudecode
    }
    $res;
}

#  end of encrypt routines

### only used in debugging #####

sub savetext {
	my ($filename,$filetext)=@_;
	open OUT,">/tmp/$filename";
	print OUT $filetext;
	close OUT;
}
sub URLEncode
{
    my($url)=@_;
    my(@characters)=split(/(\%[0-9a-fA-F]{2})/,$url);
    foreach(@characters)
    {
	if ( /\%[0-9a-fA-F]{2}/ ) # Escaped character set ...
	{
	    unless ( /(20|7f|[0189a-fA-F][0-9a-fA-F])/i
		    || /2[2356fF]|3[a-fA-F]|40/i )
	    {
		s/\%([2-7][0-9a-fA-F])/sprintf "%c",hex($1)/e;
	    }
	}
	else # Other stuff
	{
	    s/([\000-\040\177-\377\074\076\042\+])
	     /sprintf "%%%02x",unpack("C",$1)/egx;
	}
    }
    return join("",@characters);
}
# RC4 perl encryption routine by Andy Welter May 2001
# Encrypt a buffer at a type.  Encryption is a stateful
# process, so we use the "@state" global variable to track
# the state.
sub rc4 {
my ($buf) = @_;
my ($ebuf, $char);
my $x=0;
my $y=0;

for(unpack('C*',$buf)) {
	$x++;
	$y=($state[$x%=256]+$y)%256;
	@state[$x,$y]=@state[$y,$x];
	$char= pack (C, 
		$_^=$state[ ($state[$x] + $state[$y]) %256 ]);
	$ebuf= $ebuf . $char;
	};
return $ebuf;
};

sub prepkey {
#
# Prepare the encryption key
#
my ($key)=@_;
my @hexkey=unpack('C*',$key);
my ($x, $y)=("0","0");
my @t;
my @state;
for(@t=@state=0..255){
	$y=($hexkey[$_%@hexkey]+$state[$x=$_]+$y)%256;
	@state[$x,$y]=@state[$y,$x];
	#&swap;
}
return @state;
};

sub encrypt_rc4 {
	my ($key,$buf)=@_;
	local @state=&prepkey($key);
	return &rc4($buf);
};
sub tablebutton
{
	my ($text) = @_;
	return "<table border=1><tr><td BGCOLOR=\#9999FF><B><center>".$text."</center></B></td></tr></table>\n";
}
# this function will take a user's mail server host name and retrieve all port
# and host data to connect to it if not default.

sub getserverdata {
	my ($userserver)=@_;
	  $imapserver=$userserver if $userserver;
	  if (defined $server_hosts{$userserver}) {
	  #	$serverdisplay=$server_hosts{$userserver}[0] if $server_hosts{$userserver}[0];
		$imapport=$server_hosts{$userserver}[1] if $server_hosts{$userserver}[1];
		$sieveport=$server_hosts{$userserver}[2] if $server_hosts{$userserver}[2];
		$maildomain=$server_hosts{$userserver}[3] if $server_hosts{$userserver}[3];
		$mailhostappend=$server_hosts{$userserver}[4] if $server_hosts{$userserver}[4];
		my $sslopts=$server_hosts{$userserver}[5];
		if ($sslopts) {
			$useimapSSL=1 if ($sslopts=~/imap|both|all|^ssl$/i);
			$usesieveSSL=1 if ($sslopts=~/sieve|both|all|^ssl$/i);
		}
	  
	  }
	  return ($imapserver);
}

sub confirmmbxdelete {
    if( !$ismanager ) {
        print "<b>Access not allowed</b><br>";
        return;
    }
    $mbx=param('delmailbox');
    return if !$mbx;
    if ($mbx=~/\*/) {
    	print "<B>Warning! You are attempting a wildcard delete !!! Not allowed!</b><br>";
	return;
    }
    param('delmailbox',$mbx);
    param( 'action', 'deletembx' );
    print hidden('delmailbox');
    print hidden('mbx');
    print "<CENTER><BR><H4> Confirm: Really delete $mbx from server $imapserver</H4><BR>";
    print "<BR><CENTER>",submit("Confirm Delete"),"</CENTER>";
    print "<BR> If so, press the 'Confirm Delete' button.\n";
    print "<BR> If not, press the back button in your browser.\n</CENTER>";
    return;
}

sub deleteimapmailbox {

    if( !$ismanager ) {
        print "<b>Access not allowed</b><br>";
        return;
    }
    $mbx=param('delmailbox');
    return if !$mbx;
    if ($ismanager ) {
	    my $err = setacl( $mbx , 
        	              $uid, 
                	      "lrswipcda" 
                    	)." <BR> ";
    }
    $err.=  &deletemailbox($mbx);
    
    if ( $err ) {
        print hr,"<b>DeleteMailbox Error:</b> imapdelerr $err";
        return;
        
    } else {
        print "Mailbox: $mbx  deleted.<BR>";
    }

}

sub mailruleupd {
	my ($uid)=@_;
	open (MAIL, "|$sendcmd");
	print MAIL "From: $fromaddr\n";
	print MAIL "To: $toaddr\n";
	print MAIL "Subject: Filter activation\n";
	print MAIL "X-Customfilter: $uid $adminsecret\n";
	print MAIL "\n";
	print MAIL "Filter activation message for $uid";
	close(MAIL);
}