#!/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 '/usr/local/etc/websieve/funclib.pl';
require '/usr/local/etc/websieve/websieve.conf';
# get the list of available imap servers
@serverlist=keys %server_hosts;
if ($useauth) { require '/usr/local/etc/websieve/auth.pl';}
if ($useldapextras) {
require '/usr/local/etc/websieve/ldapextras.conf';
require '/usr/local/etc/websieve/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: 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 " ".submit('Select Folder')." ".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)." ".submit("Select","Select $subtext")." (Wildcards allowed [*])</TD></TR>";
}
print "<TR><TD $cb ><b>Foreign User ID:</b></TD>";
print "<TD $cb>".textfield("acluser")." (User ID to assign access rights) ".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 " <b>Disk Quota Used (KB):</b> ".$imapquota[1]." ".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")." ";
print "<b>Partition: </b>",textfield("partition") if $ismanager;
print" ". submit('Create Mailbox',"Create $subtext")." </TR>";
print "<TR><TD $cb ><b>$subtext to Delete:</b></TD><TD $cb>".textfield("delmailbox")." ".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)
. " ".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')," ",submit("Refresh")," ",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 " <b>Priority: </b>",textfield("rules.priority.$rulecount",$spriority,2);
print " <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> '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> </TD><TD $cb >";
print " '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> </TD><TD $cb>";
print " '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> </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> </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> </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> </TD><TD $cb valign=top><input type=radio $check4 name=rules.desttype.$rulecount value=\"discard\"> Discard </TD><TD $cb> </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 ")," ",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')," ",submit("Refresh")," ",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')," ",submit("Refresh")," ",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')," ",submit("Refresh")," ",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);
}
syntax highlighted by Code2HTML, v. 0.9.1