1#!/usr/local/bin/perl -w
2#  Websieve Cyrus Mail Account Management Tool by Alain Turbide
3#
4$version="0.63a";
5use CGI qw(:standard :html3);
6use CGI::Carp qw(fatalsToBrowser set_message);
7
8
9#predeclare variables from websieve.conf
10use vars qw($sieveport $imapport $defaultscript $allowadvanced $header1);
11use vars qw($maildomain $mailhostappend $problem_email @namespaces $includepublic);
12use vars qw($usereply $usereject $useacl $usediscard $usevariablefield);
13use vars qw($useregex $usevacation $usereply $shortacl $usemulti $usematches);
14use vars qw($usesearchflg $usecustom $keepredirect $quotemailbox $tb $cb $bg);
15use vars qw($showmenu $showhome $showserver $nobyline $expires $OLDMODIFY);
16use vars qw($LOGOUTURL $HOMEURL $HELPURL $VIEWRULESURL $SETVACATIONURL);
17use vars qw($SETACLURL $ADDRULEURL $SETPASSWORDURL $ADVANCEDURL $ADMINMENUURL);
18use vars qw($FORWARDALLURL $useforwardall $IMAPERROR $SIEVEERROR $imap);
19use vars qw($server_hosts $useserverselect $useimapSSL $usesieveSSL);
20use vars qw($returntoview $usesize $err @list %vacation %modevals @serverlist);
21use vars qw($uid $res $scriptname $scriptdef $pseudo $mode $sieve);
22use vars qw($imapserver $pass $op $msgdest $namespace $regexflg $regexbit);
23use vars qw($sizeflg $copyflg $copybit $searchbit $tmp $matchflg $version);
24use vars qw($sizebit $change $line $script $oldscript $oldmode $rules);
25use vars qw($useauth %scripts $rulelist $rulesorig $delimiter $skey);
26use vars qw($useservercookie $alt_namespace $vacation_prelude $userc4 $maxrules);
27use vars qw($useldapextras $gomodifyit $ldappassattr $LDAP_SERVER);
28use vars qw($LDAP_BASEDN $ENCRYPT_PASS $selectbyacl $partition);
29use vars qw($keepbit $keepflg $ismanager $cyrusadminuid $unixhiersep);
30use vars qw($sendcmd $touser $fromuser $useprocmail );
31$unixhiersep="\." if !$unixhiersep;
32
33if( $useldapextras ) {
34        use vars qw($NEWUSERURL $NEWGROUPURL $LDAPSEARCHURL $manageruid);
35        use vars qw(%ldapdefgroupatts %ldapdefpersonatts @ldappersonatts);
36        use vars qw($ldapmemberatt $ldapgroup_ou $ldapperson_ou $mgrrecmail);
37        use vars qw(%donotdisplay $suggestpass $allowchghost $mailhostatt);
38}
39
40#default to using RC4 encryption for cookies of $userc4 not defined
41$userc4=1 if !defined $userc4;
42$maxrules=400;
43
44BEGIN {
45	sub handle_errors {
46		my $msg =shift;
47		if ($msg=~/login|unknown/i) {
48			&incorrect_login;
49		}
50		else {
51			print"<h2>Received a program error!</h2>Error: $msg";
52		}
53	}
54	set_message(\&handle_errors);
55	$program_url= url(-absolute=>1) if !$program_url;
56	require './funclib.pl';
57	require './websieve.conf';
58	# get the list of available imap servers
59	@serverlist=keys %server_hosts;
60
61	if ($useauth) { require './auth.pl';}
62	if ($useldapextras) {
63	    require './ldapextras.conf';
64	    require './ldapextras.pl';
65	}
66
67}
68
69if ($useprocmail) {
70    $allowadvanced=0;
71    $useregex=0;
72    $usesearchflg=0;
73    $usemulti=0;
74}
75$remote_host=remote_host();
76
77if (!$skey) {
78	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" ;
79	exit;
80}
81
82my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
83$skey=$yday.$skey.$yday;
84$session_exp='1800' if !$session_exp;
85
86
87$notflghash='';
88$copybit=1;
89$sizebit=2;
90$searchbit=4;
91$keepbit=8;
92$regexbit=128;
93$error='';
94$sencode_params='';
95%modevals = (
96	"on","Yes",
97	"off","No");
98
99$op='' if !$op;
100if (param('op')) {
101     if (param('op') eq 'logout' || param('op') eq 'login') {
102	$auth_params{'uid'}='clear';
103	$auth_params{'pass'}='clear';
104	$encode_params=&encode_list(%auth_params);
105	$encode_params=&Encrypt($encode_params,$skey) if !$userc4;
106	$encode_params=&encrypt_rc4($skey,$encode_params) if $userc4;
107	$encode_params=&encode_base64($encode_params) if $userc4;
108	$auth_cookie=cookie(-name => 'websieve',
109			-value=>$encode_params,
110			-path=>"$program_url",
111			-expires => 'now');
112	print header(-cookie=> $auth_cookie);
113	param('op','');
114	print hidden('op');
115	&web_authenticate;
116	&byline;
117	&closeimap;
118	&closesieve;
119	exit;
120  }
121
122}
123$gotcookie='';
124
125$encode_params=cookie('websieve');
126
127if (!$encode_params) {
128	$encode_params=param('s') if param('s');
129}
130if (!$encode_params && !param('login') )
131{
132	print header;
133	&web_authenticate;
134	&byline;
135	exit;
136} else {
137	if (param('login')) {
138	  $uid = param('login');
139	  $pass = param('password');
140	}
141	else  {
142	  $gotcookie=1;
143	  $encode_params=&Decrypt($encode_params,$skey) if !$userc4;
144	  $encode_params=&decode_base64($encode_params) if $userc4;
145	  $encode_params=&encrypt_rc4($skey,$encode_params) if $userc4;
146	  %auth_params=&decode_list($encode_params);
147	  $uid=$auth_params{'uid'};
148	  $pass=$auth_params{'pass'};
149	  if ($uid eq 'clear') {
150	  	print header;
151	  	&web_authenticate;
152		&byline;
153		exit;
154
155	  }
156	  my $authhost=$auth_params{'remotehost'} if $auth_params{'remotehost'};
157	  my $etime=$auth_params{'exp'} if $auth_params{'exp'};
158	  if ((time - $etime) > $session_exp) {
159	  	print header,"<b><center>Your Session has expired!</center></b><br>";
160		&web_authenticate;
161		&byline;
162		exit;
163	  }
164	  if ($authhost && $authhost ne $remote_host) {
165	  	print header," <b><center>Remote host does not match Session host!</center></b> <br>";
166		&web_authenticate;
167		&byline;
168		exit;
169	  }
170	} # else param('login')
171
172	  if (param('viewscript')) {
173	  	$viewscript=param('viewscript');
174		$gotcookie='';
175	  }
176	  else {
177	  	$viewscript=$auth_params{'script'};
178	  }
179
180	  param('viewscript',$viewscript);
181	  if (param('server') ) {
182	  	$userserver=param('server');
183		$gotcookie='';
184	  }
185	  else {
186	  	$userserver=$auth_params{'server'} if $auth_params{'server'};
187          }
188
189
190	  if ($useauth && !$userserver) {
191			# get imapserver address from auth database
192			$userserver=&auth_getuserserver;
193
194          }
195	$userserver=&getserverdata($userserver);
196	$auth_params{'uid'}=$uid;
197	$auth_params{'pass'}=$pass;
198	$auth_params{'server'}=$userserver;
199	$auth_params{'script'}=$viewscript;
200	$auth_params{'remotehost'}=$remote_host;
201	$auth_params{'exp'}=time;
202	$encode_params=&encode_list(%auth_params);
203	$encode_params=&Encrypt($encode_params,$skey) if !$userc4;
204	$encode_params=&encrypt_rc4($skey,$encode_params) if $userc4;
205	$encode_params=&encode_base64($encode_params) if $userc4;
206	$auth_cookie=cookie(-name => 'websieve',
207			-value=>$encode_params,
208			-path=>"$program_url",
209			-expires => $expires);
210	if ($uid ne "" && $pass ne "")
211	{
212	   if (&bind < 0)
213	   {
214	       print header;
215	     &incorrect_login;
216	   }
217	} else  {
218	print header;
219	   &incorrect_login;
220
221	}
222
223	if (!$allowadvanced) {
224		foreach $advanceduser (@advanceduser) {
225			$allowadvanced=1 if $uid=~/^$advanceduser/i;
226		}
227	}
228
229	$sencode_params=&URLEncode($encode_params) if $useservercookie;
230#	$sencode_params=&URLEncode($encode_params) if !$gotcookie;
231
232	&addservercookie($sencode_params) if !$gotcookie;
233#	$useservercookie=1 if !$gotcookie;
234	if (!$gotcookie && !$useservercookie) {
235		print header(-cookie=> $auth_cookie);
236	}
237	else {
238		print header;
239	}
240	$ismanager=1 if (($uid eq $manageruid) || ($uid eq $cyrusadminuid));
241	undef $gotcookie;
242	&modify_screen;
243	&closeimap;
244	&closesieve;
245	print hr if $op ;
246	&byline if ($op ne 'ldapsearch');
247	exit;
248}
249
250sub addservercookie {
251	my ($cookie) =@_;
252	$VIEWRULESURL=~s/>/&s=$cookie>/;
253	$FORWARDALLURL=~s/>/&s=$cookie>/;
254	$SETVACATIONURL=~s/>/&s=$cookie>/;
255	$SETACLURL=~s/>/&s=$cookie>/;
256	$ADDRULEURL=~s/>/&s=$cookie>/;
257	$SETPASSWORDURL=~s/>/&s=$cookie>/;
258	$ADVANCEDURL=~s/>/&s=$cookie>/;
259	$ADMINMENUURL=~s/>/&s=$cookie>/;
260
261}
262sub initscripts {
263	my ($scriptname,$scriptdef,$mode,$viewscript,$scriptsave,$deletescript,$scriptlist);
264	my (%scripts)=@_;
265	$scriptdef=$scripts{'scriptdef'};
266	$mode=$scripts{'mode'};
267	$scriptlist=$scripts{'scriptlist'};
268	$viewscript=$scripts{'viewscript'};
269	$scriptname=$viewscript;
270	$deletescript='';
271	my @scriptlist;
272	@scriptlist=split (/ /,$scriptlist);
273	if ($scripts{'active'} && $viewscript eq $scripts{'active'}) {
274		$scriptdef='on';
275	}
276	$scriptdef='on' if !$usemulti;
277	param("lastviewscr",$viewscript);
278	print hidden("lastviewscr",$viewscript);
279
280       	param("viewscript",$viewscript);
281        param("scriptname",$scriptname);
282	param("deletescript",$deletescript);
283	if ($op eq 'advanced') {
284		print "<hr>";
285		print "<TABLE border=1 width=100%><TR $cb><TD $tb>";
286 	  	print "<b><center>Advanced Settings</b></center>";
287		print "</TD><TR $cb><TD><TABLE >";
288	}
289	if ($usemulti && $op eq 'advanced') {
290
291		print "<TR><TD $cb><b>Current Scripts:</b></TD><TD $cb>",$scriptlist," (currently active script shown with *)</TD></TR>";
292
293		param("scriptdef",$scriptdef);
294		print "<TR><TD $cb><b>Activate Script?:</b></TD> <TD $cb>",radio_group("scriptdef",['off','on'],$scriptdef,'',\%modevals),"</TD></TR>";
295
296	        print "<TR><TD $cb><b>Edit script name:</b></TD> <TD $cb VALIGN=TOP>",textfield("viewscript",$viewscript,12,""),"</TD></TR>\n";
297		print "<TR><TD $cb><b>Save to script name:</b></TD> <TD $cb VALIGN=TOP>",textfield("scriptname",$scriptname,12,""),"</TD></TR>";
298  	}
299	else {
300		print hidden("scriptdef",$scriptdef);
301		print hidden("viewscript",$viewscript);
302		print hidden("scriptname",$scriptname);
303	}
304      if ($usemulti && $op eq 'advanced')
305       {
306	print "<TR><TD $cb><b>Delete script name:</b></TD> <TD $cb VALIGN=TOP>",textfield("deletescript",$deletescript,12,""),"</TD></TR>\n";
307	}
308
309	if ($allowadvanced && $op eq 'advanced')
310	 {
311		param("mode",$mode);
312       		 print "<TR><TD $cb><b>Script Mode:</b></TD> <TD $cb>",radio_group("mode",['basic','advanced'],$mode,'',''),"</TD></TR>\n";
313	}
314	else {
315		param("mode",$mode);
316		print hidden("mode");
317	}
318
319	print "</TABLE></TD></TABLE>";
320	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');
321}
322
323
324sub printpass {
325	print "<TABLE border=1 width=100%><TR $cb><TD $tb>";
326   	print "<b><center>Change Password</b>","</center>";
327	print "</TD><TR $cb><TD><TABLE >";
328	print "<TR><TD $cb><b>User ID:</b></TD><TD $cb>",textfield('authuser'),"</TD></TR>\n" if ($ismanager && $useauth);
329	print "  <TR><TD $cb><b>New Password:</b></TD><TD $cb>",password_field('pass1'),"</TD></TR>\n";
330	print "  <TR><TD $cb><b>New Password (again):</b></TD><TD $cb>",password_field('pass2'),"</TD></TR>\n";
331	print "</TABLE><TABLE CELLSPACING=1 BORDER=0 CELLPADDING=2 >\n";
332	print "</TD></TABLE></TABLE>";
333}
334
335sub modifyacl {
336	my $mbx="";
337	my $err="";
338	return if (defined param('Select'));
339	return if (defined param('Save Changes'));
340	return if (param('action') && param('action') eq 'confirmmbxdel');
341	$mbx=param("mbx") if defined param("mbx");
342	my $partition = param('partition') if param('partition');
343	my $acl='';
344	my $generalrights='';
345	$generalrights=param('rights') if defined param('rights');
346	$acl=join('',param('acl')) if defined param("acl");
347	$acl=$generalrights.$acl;
348	my ($useracl)="";
349	$useracl=param('acluser') if defined param('acluser');
350	my $maxquota;
351	$maxquota=param('aclmaxquota') if defined param('aclmaxquota');
352	my ($newmbx)="";
353	$newmbx=param('newmbx') if defined param('newmbx');
354	$mbx=~s/^ +//g;
355	$mbx=~s/ +$//g;
356	my $mbxorig=$mbx;
357	$userspace=1;
358	# check if folder is in an additional namespace
359	if (param('Select Folder')) {
360		my $selected=param('selectedmbx');
361		$selected=~/^\[([^\]^\[]*)\]/;
362		$selected=$1;
363		param('mbx',$selected.'*');
364		return;
365	}
366	if (param('Select Server')) {
367		my $imapserver=param('server');
368		return;
369	}
370	if (param('Up One Level')) {
371		my $selected=param('selectedmbx');
372		$selected=~/^\[(.*?)\]/;
373		$selected=$1;
374		$selected=~s/$unixhiersep?[^.]+$//;
375		param('mbx',$selected.'*');
376		param('selectedmbx','');
377		return;
378	}
379
380	foreach $namespace (@namespaces) {
381		if ($newmbx) {
382			if ($newmbx=~/^$namespace./i) {
383				$mbx="$newmbx";
384				$userspace=0;
385				last; # stop checking
386			}
387		}
388		elsif ($mbx=~/^$namespace./i) {
389			$userspace=0;
390			last;  # stop checking
391		}
392	}
393
394	if ($userspace) {
395		if ($alt_namespace) {
396			if ($mbx) {
397				$newmbx=$unixhiersep.$newmbx if $newmbx;
398			}
399			$mbx="".$mbx.$newmbx."";
400		}
401		else {
402##			$mbx=~s/^INBOX/user$unixhiersep$uid/i;
403			$newmbx=$unixhiersep.$newmbx if $newmbx;
404			$mbx="".$mbx.$newmbx."";
405		}
406	}
407	if ($ismanager && !$newmbx) {
408		$mbx=$mbxorig;
409	}
410	elsif ($ismanager) {
411		$mbx=$newmbx;
412		$mbx=~s/^$unixhiersep//;
413	}
414	my $change;
415	#print br,"mbx=$mbx, newmbx=$newmbx",br;return;
416
417	if ($newmbx && param('Create Mailbox')) {
418		$err=&createmailfolder($mbx,$partition);
419		if ($err) {
420		    print hr,"<b>Createmailbox Error:</b> $err<br>";
421		    return;
422		}
423		else {
424		    $change=1 ;
425		    if ($ismanager) {
426		      param('mbx',$mbx);
427		      print hidden('mbx');
428	            }
429		}
430	}
431	if (!$mbx || !(( $acl && $useracl) || $maxquota)) {
432		return;
433	}
434	if (param('Set Acl')) {
435	  $mbx="\"$mbx\"" if ($quotemailbox==1);
436	  if ( $mbx && !&listmailbox($mbx)) {
437		 $err="Mailbox does not exist!";
438	  }
439	  else {
440		$err=&setacl($mbx,$useracl,$acl);
441		$change=1;
442	 }
443	}
444	if ($maxquota && param('Set Quota')) {
445		$err=&setquota($mbx,$maxquota);
446		$change=1;
447	}
448
449	if ($err) {
450		print hr,"<b>Error</b> modifying $mbx, Err: $err\n",br;
451		return;
452	}
453	print hr,"Mailbox modification successful..<br>" if $change;
454	return;
455}
456
457
458####  View ACL's
459
460sub viewacl
461{
462	my ($tmp,@acl);
463	my (%aclhash) =(
464		"l"=>"[l]ook",
465		"r"=>"[r]ead",
466		"s"=>"[s]een",
467		"w"=>"[w]rite",
468		"i"=>"[i]nsert",
469		"p"=>"[p]ost",
470		"c"=>"[c]reate",
471		"d"=>"[d]elete",
472		"a"=>"[a]dmin",
473		#"none"=>"No Access"
474	);
475	my $mbx;
476	$mbx=param('mbx') if param('mbx');
477	if ($ismanager) {
478		#$mbx="INBOX*" if !$mbx;
479		$mbx="user".$unixhiersep.$uid.$unixhiersep."*" if !$mbx;
480		@mailboxes=&listmailbox($mbx) ;
481	}
482	if (param('Delete This Mailbox') && param('delmailbox')) {
483	    param('Delete This Mailbox','');
484	    param('action','confirmmbxdel');
485	    &confirmmbxdelete;
486	    print hidden('action');
487	    print end_form;
488	    print end_html;
489	    exit;
490	}
491	my $subtext="Folder";
492	$subtext="Mailbox" if $ismanager;
493
494	my (%rightshash)=(
495		"lrs"=>"Read (lrs)",
496		"lrsp"=>"Post (lrsp)",
497		"lrswipcd"=>"Write (lrswipcd)",
498		"lrsip"=>"Append (lrsip)",
499		"lrswipcda"=>"All (lrswipcda)",
500		"lrswipd"=>"Write-no create(lrswipd)",
501		"none"=>"Remove access (none)"
502	);
503	my (@rights)=("lrs","lrsp","lrswipcd","lrsip","lrswipcda","lrswipd","none");
504	my (@acls)=("l","r","s","w","i","p","c","d","a","none");
505
506   print "</TABLE>",hr;
507   print "<TABLE border=1 width=100%><TR $cb><TD $tb>";
508
509     	my (@tmpmbx,$eachmbx,$eachfolder);
510	my ($user,$useracl);
511   print "<b><center>ACL View for user mailbox</b>","</center></TD><TR $cb><TD >";
512   	print "<TABLE >";
513
514	print "<TR $cb>";
515	if ($shortacl ) {
516
517		print "<TD  ><b>[$subtext]-->UserID [acl]</b></TD></TR>";
518	}
519	else
520		{
521		print "<TR><TD $tb><b>Folder Name</b></TD><TD $tb><b>UserID [acl]</b></TD></TR>";
522	}
523	@tmpmbx=@mailboxes;
524	undef @acl;
525	my (@tmp,$acl_tmp,$user_tmp);
526	while (@tmpmbx) {
527		$eachmbx=shift(@tmpmbx);
528		next if ($eachmbx!~/\S/);
529		$eachfolder="$eachmbx";
530
531		# check if folder is in an additional namespace
532		foreach $namespace (@namespaces) {
533			if ($eachmbx=~/^$namespace./i) {
534				$eachfolder="$eachmbx";
535				last;	# stop checking
536			}
537		}
538		$eachfolder="\"$eachfolder\"" if ($quotemailbox==1);
539
540		@tmpacl=&getacl($eachfolder) if $eachfolder;
541#		print "tmpacl=$eachfolder==@tmpacl<br>";
542		$tmp=join(' ',@tmpacl);
543		#remove stray mailbox names that have spaces
544		$tmp=~s/^.*?" *//;
545		@tmp=split(/ /,$tmp);
546#		print "tmp2acl=$tmp<br>";
547		$tmp='';
548		while (@tmp) {
549			$user_tmp=shift(@tmp);
550			next if !$user_tmp;
551			$acl_tmp="[".shift(@tmp)."]" if @tmp;
552			$tmp.=", " if $tmp;
553			$tmp.="$user_tmp=$acl_tmp";
554		}
555
556		if ($shortacl) {
557			if (!$tmp) {
558				$tmp='<empty>';
559			}
560
561			$tmp="[$eachmbx]---->".$tmp;
562			push (@aclview,$tmp);
563		}
564		else {
565			print "<TR><TD ><b>$eachmbx</b></TD><TD $cb>$tmp</TD></TR>";
566
567		}
568
569	}
570	@tmpbox=@mailboxes;
571	push (@tmpbox," ") if $alt_namespace;
572        print "<TR><TD >",popup_menu('selectedmbx',[@aclview],' ') if ($shortacl);
573	print "&nbsp;&nbsp;".submit('Select Folder')."&nbsp;".submit('Up One Level')."</TD></TR>" if ($shortacl && $ismanager);
574
575	print "</TABLE>";
576	print "</TD></TABLE>";
577   print br,"<TABLE border=1 width=100%><TR $cb><TD $tb>";
578	$mbx=shift(@tmpbox);
579        param('mbx',$mbx);
580        param('acluser','');
581        param('newmbx','');
582	param('acl','');
583	param('rights','-');
584
585   print "<center><b>Access Control List Entry:</b> $uid","</center></TD><TR $cb><TD>" if !$ismanager;
586   	print "<center><b>Mailbox ACL and Quota Management</b></center></TD><TR $cb><TD>" if $ismanager;
587	print "<TABLE>";
588        print "<TR $cb><TD><b>$subtext:</b></TD><TD $cb>";
589	if (!$ismanager) {
590                print popup_menu('mbx',[@tmpbox],' ')."</TD></TR>";
591	} else {
592		print textfield("mbx","",48)."&nbsp;&nbsp;&nbsp;".submit("Select","Select $subtext")."&nbsp;&nbsp;(Wildcards allowed [*])</TD></TR>";
593	}
594
595	print "<TR><TD $cb ><b>Foreign User ID:</b></TD>";
596        print "<TD $cb>".textfield("acluser")."&nbsp;(User ID to assign access rights) &nbsp;".submit("Set Acl")."</TD></TR>";
597
598	print "<TD><b> General Rights:</b></TD><TD $cb>".radio_group('rights',[@rights],"-",'',\%rightshash)."</TD></TR>";
599	print "<TR><TD $cb><b>Specific Rights:</b></TD><TD $cb>".checkbox_group('acl',[@acls],'','',\%aclhash)."</TD></TR>";
600	if ($ismanager) {
601		my @imapquota=&getquota($mbx) if ($havequota || !$useprocmail);
602		param('aclmaxquota','');
603		param('aclmaxquota',$imapquota[2]);
604		print "<TR><TD><$cb><B>Disk Quota Limit (KB):</b></TD><TD $cb>";
605		print textfield('aclmaxquota',$imapquota[2],20,40);
606	   print "&nbsp;&nbsp;<b>Disk Quota Used (KB):</b>&nbsp;&nbsp;".$imapquota[1]."&nbsp;&nbsp;".submit("Set Quota")."</TD></TR>";
607	}
608	print "</TABLE>";
609	print "</TD></TABLE>",br;
610  	print "<TABLE border=1 width=100%><TR $cb><TD $tb>";
611   	print "<b><center>New Folder Creation</b></center></TD><TR><TD $cb>" if !$ismanager;
612   	print "<b><center>$subtext Creation</b></center></TD><TR><TD $cb>" if $ismanager;
613
614	print "<TABLE>";
615	param('delmailbox','');
616	param('newmbx','');
617	param('partition','');
618	print "<TR><TD $cb ><b>$subtext to Create:</b></TD><TD $cb>".textfield("newmbx")."&nbsp;&nbsp;";
619	print "<b>Partition: </b>",textfield("partition") if $ismanager;
620	print"&nbsp;&nbsp;". submit('Create Mailbox',"Create $subtext")."&nbsp;&nbsp;</TR>";
621	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;
622		print "<TR><TD $cb><b>Mail Server:  </b></TD><TD $cb>",popup_menu("server",[@serverlist],$imapserver,\%serverdisplay)
623		. "&nbsp;&nbsp;&nbsp;".submit("Select Server","Select Server")."</tr>" if $ismanager;
624
625	print "</TABLE>";
626	print "</TD></TABLE>";
627  }
628
629sub getuserinfo {
630	my ($res,$script,$mode,$pseudo,$oldmode);
631	my (@tmpboxes,@tmprules,@tmpscr);
632	my (@scriptlist,$scriptlist,$scriptname,$scriptdef);
633
634 	undef @rules;
635	undef @mailboxes;
636	undef @quota;
637	undef %vacation;
638	undef %scripts;
639
640#creates global variables $mode,@rules,@mailboxes,@quota and %vacation;
641# get quota
642	@quota=&getquota("INBOX") if ($havequota || !$useprocmail);
643	if ($IMAPERROR !~ /no errors/i && !$ismanager && $IMAPERROR) {
644		$error=$IMAPERROR;
645		&closeimap;
646		&closesieve;
647		&incorrect_login;
648		exit;
649	}
650
651#print "quota=@quota";
652# get mailboxes
653	@tmpboxes=&listmailbox("*") if (!$ismanager);
654	# remove "user.userid" prefix
655	#place empty element in @mailboxes for display purposes
656	push (@mailboxes,' ');
657
658	while (@tmpboxes) {
659		$tmpline=shift(@tmpboxes);
660		chomp($tmpline);
661		$tmpline=~s/\r//g;
662
663		if ($alt_namespace) {
664			$tmpline=~s/^ *user$unixhiersep$uid$unixhiersep* * /INBOX$unixhiersep/i;
665		}
666		else {
667			$tmpline=~s/^ *user$unixhiersep$uid$unixhiersep* *//i;
668		}
669
670		#thiswill be set true if "anyone" identifier has any privs
671		# for the folder defined by $tmpline
672		my $public=1;
673
674		#this will be set true if this user has admin privs for
675		#this folder
676		my $ownedbyuser = 0;
677		#Display all folders if Manager is user
678	       $includepublic=1 if $ismanager;
679	       if ($selectbyacl) {
680		my @tmpacl = &getacl($tmpline);
681		#following 5 lines fix returned acl values when folders contain
682		# spaces when using IMAP::Admin
683		$tmp=join(' ',@tmpacl);
684		#remove stray mailbox names that have spaces
685		$tmp=~s/^.*?" *//;
686		@acl=split(/ /,$tmp);
687		$tmp='';
688
689		while(@acl) {
690			my $line=shift(@acl);
691			$public = 1 if ($line=~ /anyone/i);
692			if ($line=~/$uid/i) {
693				my $useracl=shift(@acl);
694				$ownedbyuser=1 if ($useracl=~/a/i);
695			}
696		}
697
698		$tmpline = "" if (($public)&&(!$ownedbyuser)&&(!$includepublic));
699	       }
700	       else {
701
702		if (($tmpline!~/^INBOX|$uid/i) && (!$includepublic)) {
703		$tmpline="";
704		}
705	      }
706		push (@mailboxes,$tmpline) if ($tmpline=~/\S/);
707
708
709	}
710# get mailboxes from other namespaces
711	foreach $namespace(@namespaces) {
712		push (@mailboxes,&listmailbox("$namespace.*"));
713	}
714
715#get scriptlists
716      if (!$useprocmail) {
717	&opensieve($uid,$pass,$sieveport,$imapserver) if (!$sieve);
718        if (!$sieve) {
719                print start_html(-title=>'Error login in to Sieve Server',-BGCOLOR=>'red'),
720                h2("Error login in to Sieve Server: $imapserver <br>"),
721                "There is a problem accessing the Sieve Server, click <a href=" . $program_url . "?op=login>HERE</a> and try again.\n";
722                &closesieve;
723                &closeimap;
724                exit;
725         }
726	@scriptlist=&listscripts;
727	while (@scriptlist) {
728		$_=shift(@scriptlist);
729		if (/\*|ACTIVE/) {
730			$defaultscript=$_;
731			$defaultscript=~s/\*| *ACTIVE//g;
732			$_="<b>".$defaultscript."*</b>";
733			$scripts{'active'}=$defaultscript;
734
735
736		}
737		if ($scriptlist) {$scriptlist.=', ';}
738		$scriptlist.=$_;
739	}
740	if (!param('viewscript')) {
741		$scriptname=$defaultscript;
742		$viewscript=$defaultscript;
743		$scriptdef='off';
744	}
745	else {
746		$scriptname=param('scriptname');
747		$viewscript=param('viewscript');
748
749		$scriptdef=param('scriptdef');
750
751	}
752       } # if not useprocmail
753
754# get sieve scripts
755      if (!$useprocmail) {
756
757	$pseudo=&getscript($viewscript."_pseudo");
758	$script=&getscript($viewscript);
759	$script=$script.$pseudo;
760       }
761       else {
762       	  $script=&auth_getattrib($matchingrules);
763       }
764
765	if ( $SIEVEERROR && $SIEVEERROR !~ /No Error/i && $SIEVEERROR !~ /doesn.t exist/i) {
766		print "Error: getscript->".$SIEVEERROR."<br>";
767	}
768	#combined script and pseudo files to enable easy compatibility with old method
769	#of having rules in same file as script
770
771	@tmprules=split(/\n/,$script) if ($script);
772	@tmpscr=grep !/#rule|#mode|#vacation|##pseudo/i,@tmprules;
773	#remove pseudo rules and CR's from main script
774	$script=join("\n",@tmpscr);
775	@tmprules=grep  /^ *\#\#pseudo|^ *#rule|^ *#mode|^ *#vacation/i, @tmprules;
776	$pseudo=join("\n",@tmprules);
777	while (@tmprules) {
778		$_=shift(@tmprules);
779		if (s/^ *#rule&& *//i) {
780			s/\r//g;
781			push(@rules,$_);
782		}
783
784                elsif (/^ *#vacation&&(.*)&&(.*)&&(.*)&&(.*)/i) {
785			$vacation{'days'}=$1;
786			$vacation{'addresses'}="$2";
787			$vacation{'text'}=$3;
788			$vacation{'mode'}=$4;
789			$vacation{'addresses'}=~s/\\@/\@/g;
790			$vacation{'addresses'}=~s/\"//g;
791
792		}
793	       elsif (/^ *#mode&&(.*)/) {
794	       		$mode=$1;
795			$oldmode=$mode;
796		}
797
798	}
799        if ( !defined %vacation) {
800               $vacation{'mode'}='off';
801               $vacation{'days'}='1';
802               $vacation{'text'}='On vacation for the next week';
803        }
804	if (!$vacation{'addresses'}) {
805               $vacation{'addresses'}="$uid\@$maildomain $uid\@$mailhostappend";
806	}
807
808	if ($allowadvanced && param('mode') && (param('viewscript') eq param('scriptname'))) {
809		$mode=param('mode');
810	}
811	elsif (!$allowadvanced || !$mode)  {
812		$mode='basic';
813	}
814
815	$scripts{'script'}=$script if $script;
816	$scripts{'pseudo'}=$pseudo;
817	$scripts{'mode'}=$mode;
818	$scripts{'oldmode'}=$oldmode;
819	$scripts{'scriptname'}=$scriptname;
820	$scripts{'viewscript'}=$viewscript;
821	$scripts{'scriptlist'}=$scriptlist;
822	$scripts{'scriptdef'}=$scriptdef;
823	$scripts{'deletescript'}=param('deletescript');
824	return %scripts;
825}
826
827sub printscript {
828	my ($script)=@_;
829	param("script",$script);
830	print "<HR><TABLE border=1 ><TR $cb><TD $tb><center><b>Sieve Script Edit</b></center></TD>";
831        print "<TR><TD $cb>",textarea("script",$script,30,100,"","wrap=virtual"),"</TD></TR>";
832
833	print "</TABLE>";
834
835}
836
837
838# print web form and display all current rules
839# also display form to accept a new rule
840
841sub printrules {
842#	my (@fieldlist)=("subject","from","to");
843	my (%actions,%contain);
844	my (@ruletype)=('DISABLED','ENABLED','DELETE','MODIFY');
845	my (@desttype)=("folder","address");
846	my ($fieldname,$fieldval,$sdest,$sdest1,$sto,$sfrom,$ssubject,$destt,$sdest2,$sdest3,$check1,$check2,$check3,$check4,$check5,$joinop,$size);
847	my ($applyall,$searchflg);
848	my ($sfield,$svalues,$scopyflg,$sregexflg,$sfieldname,$sfieldval,$ssize,$skeepflg);
849	$ssize=$sfieldname=$sfieldval=$sfrom=$sto=$ssubject=$sdest=$sdest0=$sdest1=$sdest3=$check3=$check4='';
850	$sflg=$ssizeflg=0;
851	push (@desttype,' ');
852	# retrieve rules string from global hash %record where key is matchingrules
853	#convert rules string to an array
854	$sdest=$svalues=$sfield;
855	$scopyflg='';
856	$sregexflg='';
857	$skeepflg='';
858	my ($sdestt)='folder';
859	%actions = (
860		"folder","File Into",
861		"address","Forward To",
862		"reply","Reply with",
863		"reject","Reject",
864		"discard","Discard"
865		);
866
867	my (@flgsts)=(0,1);
868	%notflghash=(
869		0,"contains",
870		1,"does not contain",
871		);
872	%searchflghash = (
873		0," all of ",
874		1," any of "
875		);
876	%sizeflghash = (
877		0," less ",
878		2," greater "
879		);
880	%copyhash = (
881		'keep',"Keep a copy in your Inbox",
882		'copy',"Continue checking other rules after applying this rule",
883		'regex',"Use regular expressions"
884		);
885	my ($toggle,$priority,$line,$dest,$field,$flg,$copyflg,$sizeflg,$keepflg);
886	my ($rulecount)=0;
887	my ($pcount)=1;
888 # insert view rules here..
889   if ($op eq 'viewrules' ) {
890
891	print hr,"<TABLE border=1 width=100%><TR $cb><TD $tb>";
892   	print "<b><center>Viewing Rules for:</b> $uid","</center>";
893
894	print "</TD><TR $cb><TD><TABLE border=1 width=100%>";
895	print "<TR><TD $tb width=18% align=right><b>[Rule#]  Priority - Status</b></TD><TD $tb align=center ><b>Current Rules</b></TD>";
896	# only print if viewing...
897   } # if viewrules
898
899	@tmprules=@rules;
900	$modrule="";
901	while (@tmprules) {
902		$line=shift(@tmprules);
903		chomp($line);
904		$line=~s/\s*//;
905		$line=~s/\s$//;
906		$line=~s/\r//g;
907		($priority,$ruletype,$from,$to,$subject,$destt,$dest,$flg,$fieldname,$fieldval,$size)=split('&&',$line);
908		if ((!($from || $to || $subject || $size || ($fieldname&&$fieldval)) || !$ruletype) && !$dest) {
909			next;
910		}
911		#this line to support old version of websieve scripts
912		if ($flg=~/copy/i) {
913			$flg=$copybit;
914		}
915		$flg=0 if !$flg;
916		$copyflg= ($flg & $copybit);
917	        $searchflg=($flg & $searchbit);
918		$searchflg=0 if !$searchflg;
919		$sizeflg=($flg & $sizebit);
920		$regexflg=($flg & $regexbit);
921		$keepflg=($flg & $keepbit);
922		$priority=$pcount;
923		$applyall='';
924		$applyall=1 if (!($to | $from | $subject | $fieldname | $fieldval | $size) && $dest);
925		# if it is a modify rule then save this rule for modify later
926		if (($ruletype=~/modify/i || ($applyall && $op eq 'forward' && $destt eq 'address')) && !($sto || $sfrom || $ssubject || $sdest || $ssize)) {
927			# can use 'DELETE' but data loss in form submit might cause a new rule to be lost if using IE
928			$ruletype=$OLDMODIFY;
929			$sto=$to;
930			$sfrom=$from;
931			$ssubject=$subject;
932			$modrule="1";
933			$spriority=$priority-1;
934			$sdestt=$destt;
935			$sdest=$dest;
936			$scopyflg=$copyflg;
937			$ssizeflg=$sizeflg;
938			$skeepflg=$keepflg;
939			$sflg=$flg;
940			$sregexflg=$regexflg ;
941			$ssearchflg=$searchflg;
942			$sfieldname=$fieldname ;
943			$sfieldval=$fieldval ;
944			$ssize=$size;
945			# save values for modify later
946		}
947
948		param("rules.priority.$rulecount","$priority");
949		param("rules.ruletype.$rulecount",$ruletype);
950		param("rules.searchflg.$rulecount",$searchflg);
951	     if ($op eq 'forward' && $ruletype=~/DELETE/i) {
952	     		print hidden("rules.priority.$rulecount");
953			print hidden("rules.ruletype.$rulecount");
954	     }
955	     if ($op eq 'viewrules' ) {
956		# only print if viewer
957		print "<TR>\n";
958		print "<TD $cb align=right valign=top>[<b>$rulecount</b>] ",textfield("rules.priority.$rulecount",$priority,2), popup_menu("rules.ruletype.$rulecount",[@ruletype],$ruletype),"</TD>";
959		print "<TD $cb >";
960	      if ($destt ne 'custom' ) {
961
962		print "IF " if !$applyall;
963		print "<b>[Unconditional Rule]</b> " if $applyall;
964		$searchflg=0;
965		$searchflg=1 if ($flg & $searchbit);
966		# only if viewing
967		my ($wc)='';
968		my %contains;
969		if ($regexflg) {
970			$contains{'to'}=$contains{'from'}=$contains{'subject'}=$contains{'field'}='matches regex';
971		}
972		else {
973
974			$contains{'to'}=$contains{'from'}=$contains{'subject'}=$contains{'field'}='contains';
975			$contains{'to'}='matches' if $to=~/\*|\?/;
976			$contains{'to'}.='{not} ' if $to=~/^\s*!/;
977			$contains{'from'}='matches' if $from=~/\*|\?/;
978			$contains{'from'}.='{not} ' if $from=~/^\s*!/;
979			$contains{'subject'}='matches' if $subject=~/\*|\?/;
980			$contains{'subject'}.='{not} ' if $subject=~/^\s*!/;
981			$contains{'field'}='matches' if $fieldval=~/\*|\?/;
982			$contains{'field'}='{not} matches' if $fieldval=~/^\s*!/;
983			$contains{'size'}='msg size <b>less</b> than';
984			$contains{'size'}='msg size <b>greater</b> than' if $sizeflg;
985
986		}
987		$joinop='AND';
988		$joinop='OR' if $searchflg;
989
990
991		if ($from) {
992			print "\'<b>From</b>\' $contains{'from'} \'<b>",$wc.$from.$wc,"</b>\' ";
993		}
994		if ($to) {
995			if ($from) {print " $joinop field: ";}
996			print "\'<b>To</b>\' $contains{'to'} \'<b>",$wc.$to.$wc,"</b>\'";
997		}
998		if ($subject) {
999			if ($to | $from) {print " $joinop field: ";}
1000			print "\'<b>Subject</b>\' $contains{'subject'} \'<b>",$wc.$subject.$wc,"</b>\'";
1001		}
1002		if ($fieldname) {
1003			if ($to | $from | $subject) {print " $joinop field: ";}
1004			print "\'<b>$fieldname</b>\' $contains{'field'} \'<b>",$wc.$fieldval.$wc,"</b>\'";
1005		}
1006		if ($size) {
1007			my $kb='K';
1008			$kb="K" if $size=~s/k//gi;
1009			if ($to | $from | $subject | $fieldname) {print " $joinop ";}
1010			print " $contains{'size'} \'<b>$size"."$kb</b>\'";
1011		}
1012
1013		#$dest=~s/^(.{40}).*/$1->(more)/;
1014		$dest=~s/\\n/<br>/g;
1015		print " THEN " if !$applyall;
1016		print "$actions{$destt} "," \'<b>",$dest,"</b>\'";
1017	       } # if !$custom
1018	       else {
1019#		$dest=~s/^(.{40}).*/$1->(more)/;
1020		$dest=~s/\\n/<br>/g;
1021	      	print "<b>Custom Rule:</b> $dest";
1022	      }
1023
1024		if ($copyflg) {
1025			print " - [Continue]";
1026
1027		}
1028		if ($keepflg) {
1029			print " - [Keep a copy]";
1030		}
1031		print "</TD>\n";
1032
1033
1034		print "</TR>";
1035
1036		# only if viewing..
1037
1038           } #if viewrules
1039
1040		$rulecount++;
1041		$pcount+=2;
1042	} # while
1043	if (!defined($spriority)) {$spriority=$pcount-1;}
1044	$savedcount=$rulecount;
1045	$sdest0=' ';
1046	# set up variables for modify operation on a rule
1047	$check1='';
1048	$check2='';
1049	$check0='';
1050	$check5='';
1051
1052	my $customrule='';
1053	if (!$sdest) {$sdest=' ';}
1054	if ($sdestt=~/address/i) {
1055		$sdest1=$sdest;
1056		$check1='checked';
1057	}
1058	elsif ($sdestt=~/reply/i) {
1059		$sdest2=$sdest;
1060		$sdest2=~s/\\n/\r\n/g;
1061		$check2='checked';
1062	}
1063	elsif ($sdestt=~/folder/i) {
1064		$sdest0=$sdest;
1065		$check0='checked';
1066	}
1067	elsif ($sdestt=~/reject/i) {
1068		$check3='checked';
1069		$sdest3=$sdest;
1070		$sdest3=~s/\\n/\r\n/g;
1071	}
1072	elsif ($sdestt=~/discard/i) {
1073		$check4='checked';
1074	}
1075	elsif ($sdestt=~/custom/i) {
1076		$customrule=1;
1077		$check5='checked';
1078		$sdest5=$sdest;
1079		$sdest5=~s/\\n/\n/g;
1080	}
1081
1082	if ($op eq 'viewrules' ) {
1083	print "</TABLE>";
1084	print "</TD></TABLE>";
1085	if (!$rulecount) {
1086		print " [No Rules avalailable]<br>";
1087	}
1088	print "<hr><center>",submit('Save Changes'),"&nbsp;&nbsp;",submit("Refresh"),"&nbsp;&nbsp;",reset("Reset Values"),"</center>";
1089
1090	} # if viewrules
1091     if (($op eq 'addrule'  || $modrule) && ($op ne 'forward')) {
1092	$modrule="";
1093#### New Rule Entry
1094	my ($wild)="Hint: Use * or ? for wildcards<br> To invert a rule use ! as the first character of your search string" ;
1095	print hr,"<TABLE border=1 width=100%><TR $cb><TD $tb>";
1096	print "<center><b>New Rule Entry for user: </b>$uid</center></TD></TR><TR $cb><TD>";
1097	print "<TABLE >";
1098	print "<TR $cb><TD><b>Rule#: </b>[$rulecount]";
1099		print "&nbsp;&nbsp;<b>Priority: </b>",textfield("rules.priority.$rulecount",$spriority,2);
1100		print "&nbsp;&nbsp;<b>Status: </b>",popup_menu("rules.ruletype.$rulecount",[@ruletype],'ENABLED'),"</TD><TD></TR>";
1101	my @checked;
1102	my @checkvalues=("copy","keep");
1103	push @checkvalues,"regex" if $useregex;
1104
1105	if ($scopyflg) {
1106		push @checked,"copy";
1107	}
1108	if ($skeepflg) {
1109		push @checked,"keep";
1110	}
1111	if ($sregexflg) {
1112		push @checked,"regex";
1113	}
1114	param("rules.copy.$rulecount",@checked);
1115
1116	print "<TD $cb>";
1117	print "<b>",checkbox_group(-name=>"rules.copy.$rulecount",
1118			     -values=>\@checkvalues,
1119			     -defaults=>\@checked,
1120			     -linebreak=>'true',
1121			     -labels=>\%copyhash),"</b>";
1122
1123	while (($rulecount==$savedcount) && ($rulecount<$maxrules)) {
1124		print "<TR border=1>\n";
1125		param("rules.ruletype.$rulecount",'ENABLED');
1126		param("rules.priority.$rulecount","$spriority");
1127		print "</TABLE><hr><TABLE >";
1128		print "<TR ><TD  >";
1129		param("rules.desttype.$rulecount","$sdestt");
1130###### FROM field
1131		print "<b>IF ";
1132		if ($usesearchflg) {
1133			$ssearchflg=0;
1134			$ssearchflg=1 if ($sflg & $searchbit);
1135			param("rules.searchflg.$rulecount","$ssearchflg");
1136			print popup_menu("rules.searchflg.$rulecount",[@flgsts],$ssearchflg,\%searchflghash);
1137		}
1138		print " field(s):</b></TD><TD $cb>&nbsp; 'from' contains ",
1139		"</TD><TD $cb >";
1140		param("rules.from.$rulecount","$sfrom");
1141		print textfield("rules.from.$rulecount","$sfrom",50),"</TD></TR>";
1142
1143############# TO field
1144		print "<TR>";
1145		print "<TD $cb align=right>&nbsp;</TD><TD $cb >";
1146		print "&nbsp; 'to' contains ",
1147		"</TD><TD $cb >";
1148		param("rules.to.$rulecount","$sto");
1149		print textfield("rules.to.$rulecount","$sto",50),"</TD></TR>";
1150
1151########### SUBJECT field
1152		print "<TR></TD>";
1153		print "<TD $cb align=right>&nbsp;</TD><TD $cb>";
1154		print "&nbsp; 'subject' contains ",
1155		"</TD><TD $cb>";
1156		param("rules.subject.$rulecount","$ssubject");
1157		print textfield("rules.subject.$rulecount","$ssubject",50),"</TD></TR>";
1158		$usesize=1 if !defined $usesize;
1159		if ($usesize) {
1160##### Size of message rule
1161		print "<TR></TD>";
1162		print "<TD $cb align=right valign=bottom>Msg size</TD><TD $cb>";
1163		param("rules.sizeflg.$rulecount","$ssizeflg");
1164		print popup_menu("rules.sizeflg.$rulecount",[(0,2)],$ssizeflg,\%sizeflghash);
1165		print " than ";
1166		print "</TD><TD $cb>";
1167		param("rules.size.$rulecount","$ssize") ;
1168		print textfield("rules.size.$rulecount","$ssize",15)," (K)ilobytes</TD></TR>";
1169		}
1170
1171		if ($usevariablefield) {
1172##### Variable field 'field'
1173		print "<TR></TD>";
1174		print "<TD $cb align=right valign=bottom>Field name</TD><TD $cb>";
1175		param("rules.fieldname.$rulecount","$sfieldname");
1176		print textfield("rules.fieldname.$rulecount",$sfieldname,10);
1177		print " contains ","</TD><TD $cb>";
1178		param("rules.fieldval.$rulecount","$sfieldval") ;
1179		print textfield("rules.fieldval.$rulecount","$sfieldval",50),"</TD></TR>";
1180		}
1181
1182######## THEN
1183####### Action FILEINTO
1184		print "<TR>";
1185		print "<TD $cb><b>THEN</b></TD><TD $cb><input type=radio $check0 name=rules.desttype.$rulecount  value=\"folder\"> File Into  </TD><TD $cb>";
1186		param("rules.mailbox.$rulecount","$sdest0");
1187		if (!$ismanager) {
1188		    print popup_menu("rules.mailbox.$rulecount",[@mailboxes],"$sdest0");
1189		} else {
1190		    print textfield("rules.mailbox.$rulecount","$sdest0",50);
1191		}
1192		print " (Mail Folder) </TR><TR>";
1193
1194############## Action REDIRECT
1195		param("rules.forward.$rulecount","$sdest1");
1196		print "<TD $cb>&nbsp;</TD><TD $cb><input type=radio $check1 name=rules.desttype.$rulecount value=\"address\"> Forward To </TD><TD $cb>";
1197		print textfield("rules.forward.$rulecount",$sdest1,50)," (Email Address) </TD></TR><TR>";
1198
1199############### Action REPLY WITH
1200		if ($usereply) {
1201
1202			param("rules.reply.$rulecount","$sdest2") if (defined $sdest2);
1203			print "<TD $cb>&nbsp;</TD><TD $cb valign=top><input type=radio $check2 name=rules.desttype.$rulecount value=\"reply\"> Reply With  </TD><TD $cb>";
1204			print textarea("rules.reply.$rulecount",$sdest2,2,43)," (Text Message) </TD></TR>";
1205
1206		}
1207############## Action Reject
1208	     if ($usereject) {
1209	        	param("rules.reject.$rulecount","$sdest3");
1210		        print "<TD $cb>&nbsp;</TD><TD $cb valign=top><input type=radio $check3 name=rules.desttype.$rulecount value=\"reject\"> Reject </TD><TD $cb>";
1211		        print textarea("rules.reject.$rulecount",$sdest3,2,43)," (Text Message) </TD></TR>";
1212	     }
1213############## Action Discard
1214	     if ($usediscard) {
1215		        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>";
1216	     }
1217
1218############### Action CustomCode
1219    	  if ($usecustom  ) {
1220	  	print "<TR>";
1221		param("rules.custom.$rulecount","$sdest5") if (defined $sdest5);
1222		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>";
1223		print textarea("rules.custom.$rulecount",$sdest5,5,52),"</TD></TR>";
1224#		print textfield("rules.forward.$rulecount",$sdest1,35),"</TD></TR><TR>";
1225
1226
1227          }
1228
1229#### END of Actions
1230
1231		$rulecount++;
1232	}
1233
1234	print "</TABLE>";print "</TABLE</TD></TABLE>";
1235	print hr,"<TABLE ><TR><TD >$wild</TD></TABLE>";
1236
1237	$rulecount--;
1238	print hr,"<center>",submit("Save Rule "),"&nbsp;&nbsp;",reset('Clear'),"</center>";
1239
1240      } # if addrule
1241
1242##### Forward all operation
1243    	  if ($op eq 'forward') {
1244		param("rules.priority.$rulecount","$spriority");
1245		param("rules.ruletype.$rulecount","ENABLED");
1246		param("rules.forward.$rulecount","$sdest1");
1247		param("rules.desttype.$rulecount",'address');
1248		param("rules.to.$rulecount",'');
1249		param("rules.from.$rulecount",'');
1250		param("rules.subject.$rulecount",'');
1251		param("rules.fieldname.$rulecount",'');
1252		param("rules.fieldval.$rulecount",'');
1253		# this prevents warnings further on
1254		print hidden("rules.priority.$rulecount"),
1255		hidden("rules.ruletype.$rulecount"),
1256		hidden("rules.desttype.$rulecount"),
1257		hidden("rules.to.$rulecount"),
1258		hidden("rules.from.$rulecount"),
1259		hidden("rules.subject.$rulecount"),
1260		hidden("rules.fieldname.$rulecount"),
1261		hidden("rules.fieldval.$rulecount");
1262
1263		print "</TABLE>";
1264		print hr, "<TABLE border=1 width=100%><TR $cb><TD $tb>";
1265   		print "<b><center>Forward all mail from:</b> $uid","</center></TD><TR $cb><TD><TABLE>";
1266		print "<TD $cb><b>Forward Mail To:</b> </TD><TD $cb>";
1267		print textfield("rules.forward.$rulecount",$sdest1,52);
1268		print "</TD></TR><TR><td></TD><TD $cb>";
1269		print "<b>NOTE: If you want to keep a copy of messages that ",
1270		"you are<br>forwarding, don't use this screen. Create a",
1271		" new filter rule to<br>redirect your mail instead.</b>";
1272		print "</TD></TR></TABLE></TABLE>";
1273
1274	  }
1275
1276	param('rulescount',$rulecount);
1277	print hidden('rulescount');
1278
1279
1280}
1281
1282
1283sub printinfo {
1284	my $percent='0.00';
1285	$percent= sprintf "%2.2d",$quota[1]/$quota[2]*100 if ($quota[2]);
1286	print "<center><TABLE border=1><TR $cb><TD><TABLE><TR>\n";
1287	print "<TD $cb><b>Server: </b>$imapserver</TD><TD $cb><b>Userid: </b>$uid</TD>";
1288	print "<TD $cb><b>Used Quota: </b>";
1289	if ($percent ne "" && ($havequota || !$useprocmail)) {
1290		print "[<b>$quota[1]</b> kbytes used /<b> $quota[2]</b> kbytes available.($percent\% usage)]</TD>";
1291	} else {
1292		print "<TD $cb><b>$quota[1]</b> No limits</TD>";
1293	};
1294	if ($usemulti && !$useprocmail) {
1295		print "<TD $cb><b>Script: </b>[$viewscript]</TD>"
1296	}
1297
1298	print "</TD></TABLE></TABLE></center>";
1299
1300}
1301
1302sub byline
1303{
1304	return if $nobyline;
1305	print "<p><br><CENTER><b>Websieve</b><br>";
1306	print "Mail Account Management Tool Version: $version<br>Written by: Alain Turbide<br>";
1307      print '<ADDRESS><A HREF=mailto:aturbide@toshiba.ca>aturbide@toshiba.ca</A></ADDRESS></CENTER></p>';
1308
1309	return;
1310}
1311
1312sub incorrect_login
1313{
1314	print start_html(-title=>'Login Error!',-BGCOLOR=>'yellow'),
1315		h2('Login Error'),
1316		"There was an error in loging you in to the server.  Please ",
1317		"click <a href=" . $program_url . "?op=login>HERE</a> and try again.\n";
1318	if ($error !~ /sieve/i) {
1319		print "<p><b>System Error: </b>$error";
1320		print "<br>User server=$userserver<br>";
1321	}
1322	else {
1323		print "<p><h> Wrong Password! </b>";
1324	}
1325	print end_html;
1326	exit;
1327
1328}
1329
1330sub web_authenticate
1331{
1332	my @slist=@serverlist;
1333	my %serverdisplay;
1334	while ($_=shift @slist) {
1335		$serverdisplay{$_}=$server_hosts{$_}[0] if $_;
1336	}
1337
1338
1339	print start_html(-title=>$header1,-BGCOLOR=>$bg),
1340		"<BR><CENTER>",h1($header1),
1341		"For Problems with this service, please email <a href=mailto:$problem_email>$problem_email</a><br>",$HOMEURL,"<br>",
1342		start_form,"<TABLE border=1><TR $cb><TD><TABLE>",
1343
1344	 	"<TR><TD $cb>","<b>Login: </b> </TD><TD $cb>",textfield('login'),"</TD>",
1345		"<TR><TD $cb><b>Password:  </b></TD><TD $cb>",password_field('password'),"</TD>";
1346
1347		if ($useserverselect) {
1348		print "<TR><TD $cb><b>Mail Server:  </b></TD><TD $cb>",popup_menu("server",[@serverlist],$imapserver,\%serverdisplay);
1349		}
1350
1351		print "</TABLE></TD></TABLE>",br,
1352
1353		submit('Login'),"</CENTER>",
1354		hidden('op');
1355	print "<CENTER>Your \"Login\" is the same as the part of your e-mail<BR>address that goes before the \@ symbol.</CENTER>";
1356
1357		print end_form;
1358}
1359
1360sub bind
1361{
1362	  &openimap($uid,$pass,$imapserver,$imapport,$useimapSSL,$unixhiersep);
1363	  if (!$imap || $IMAPERROR=~/NO login/i) {
1364		$error=$IMAPERROR."<br>";
1365               &closeimap;
1366               return -1;  # Return Failure
1367	  }
1368
1369	  if (!$useprocmail) {
1370  	      &opensieve($uid,$pass,$sieveport,$imapserver,$usesieveSSL);
1371	      if (!$sieve || $SIEVEERROR) {
1372	  	$error.=$SIEVEERROR."<br>";
1373		&closeimap;
1374		&closesieve;
1375		return -1;
1376	      }
1377	  }
1378	  return 0;  # Return Success
1379}
1380
1381sub modify_screen
1382{
1383#  Print WWW Header
1384	my $header2="Mail Server: $userserver" if $showserver;
1385	$header2=" " if !$header2;
1386	my $err;
1387       print start_html(-title=>"$header1 for '$uid' on $userserver",-BGCOLOR=>$bg, -LINK=>"black", -VLINK=>"black"),
1388        "<CENTER>",h2("$header1 $header2"),"</CENTER>";
1389
1390	%scripts=&getuserinfo;
1391	$mode=$scripts{'mode'};
1392	$op='';
1393	$op=param('op') if param('op');
1394
1395	if ($mode =~ /advanced/i && !$op) {
1396		$op = 'viewrules';
1397	}
1398	if ($showmenu||$showhome) {
1399		print "<table align=center size=70%><tr><td>",tablebutton($HOMEURL);
1400		print "</TD><td>",tablebutton($LOGOUTURL),"</td>";
1401		if ($useldapextras) {
1402			print "<td>",tablebutton($LDAPSEARCHURL),"</td>";
1403			if ($ismanager) {
1404				print "<td>",tablebutton($NEWUSERURL),"</td>";
1405				print "<td>",tablebutton($NEWGROUPURL),"</td>";
1406				$showmenu = $mgrrecmail;
1407			}
1408		}
1409	}
1410	print "</tr></table>";
1411	print "<center><table align=center><tr>";
1412	print "<td>",tablebutton($SETPASSWORDURL),"</td>" if $useauth;
1413	print "<td>",tablebutton($SETVACATIONURL),"</td>" if ($usevacation && $mode ne 'advanced');
1414	print "<td>",tablebutton($FORWARDALLURL),"</td>" if ($useforwardall && $mode ne 'advanced');
1415	print "<td>",tablebutton($VIEWRULESURL),"</td>";
1416	print "<td>",tablebutton($ADDRULEURL),"</td>" if ($mode ne 'advanced');
1417	if ($useacl && !$ismanager) {
1418		print "<td>",tablebutton($SETACLURL),"</td>" ;
1419	}
1420	elsif ($ismanager) {
1421		print "<td>",tablebutton($ADMINMENUURL),"</td>";
1422	}
1423	print "<td>",tablebutton($ADVANCEDURL),"</td>" if ($allowadvanced || $usemulti);
1424	print "</center></tr></table>";
1425	&printinfo;
1426
1427#  Draw up the Web Form
1428	print start_form(-action=>$program_url);
1429	$gomodifyit = 'yes';
1430	 print hidden('s',$sencode_params) if $useservercookie;
1431	 print "<center>",submit('Save Changes'),"&nbsp;&nbsp;",submit("Refresh"),"&nbsp;&nbsp;",reset('Reset Values'),"</center>" if $op;
1432	param('op',$op);
1433	if (param('action') && param('action') eq 'deletembx') {
1434		&deleteimapmailbox;
1435	}
1436	#Call ldapextras functons if configured to do so
1437	$res = &ldapextras if ($useldapextras);
1438	print hidden('gomodifyit',$gomodifyit);
1439	if (param('gomodifyit'))
1440	{
1441	   &gomodifyit;
1442	   %scripts=&getuserinfo;
1443	}
1444	if ($op eq 'addrule' && $returntoview) {
1445		param('op','viewrules');
1446	}
1447	print hidden('op');
1448	&initscripts(%scripts);
1449	if ($op eq 'setacl') {
1450	 	&viewacl if $useacl;
1451		print "<hr><center>",submit('Save Changes'),"&nbsp;&nbsp;",submit("Refresh"),"&nbsp;&nbsp;",reset('Reset Values'),"</center>";
1452
1453	}
1454	if ($mode =~ /basic/i && $op ne 'setacl') {
1455		&printrules if ($op eq 'addrule' || $op eq 'viewrules' || $op eq 'forward');
1456		if ($op eq 'setvacation') {
1457	        	&printvacation if $usevacation;
1458		}
1459	}
1460	elsif (($op ne 'setpass' && $op ne 'setacl' && $op eq 'viewrules' && $op ne 'forward')  ) {
1461#		print "printing $op<br>";
1462
1463		&printscript($scripts{'script'}) ;
1464	print "<hr><center>",submit('Save Changes'),"&nbsp;&nbsp;",submit("Refresh"),"&nbsp;&nbsp;",reset('Reset Values'),"</center>";
1465
1466
1467	}
1468	if ($op eq 'setpass') {
1469		print hr;
1470		&printpass if $useauth;
1471	}
1472
1473
1474	#print "</TABLE>";
1475	end_form;
1476	return;
1477}
1478
1479
1480sub checkrules {
1481        my ($linecount,$destt,$priority,$rulecount,$linecount2,@rulelist,$oldrules,$onerule,$copyflg,$sizeflg,$keepflg,$size);
1482	$copyflg='';
1483	$dest='';
1484	$linecount=$rulecount=0;
1485
1486	$delimiter='&&';
1487	$dest="";
1488	my (@rulea,@tmprules);
1489
1490	$linecount2=param("rulescount");
1491
1492	@tmprules=@rules;
1493        # start of current rule check
1494        # only priority and ruletype can be changed here
1495
1496	if (!defined $linecount2) {
1497		$rules=join("\n",@tmprules);
1498		return ($rules);
1499	}
1500	$rulesorig='';
1501	while (@tmprules) {
1502		$line=shift(@tmprules);
1503                $rulesorig.=$line;
1504		chomp($line);
1505		$line=~s/^ +//;
1506		$line=~s/ +$//;
1507
1508		($priority,$ruletype,$from,$to,$subject,$destt,$dest,$flg,$fieldname,$fieldval,$size)=split('&&',$line);
1509		if ($flg=~/copy/i) {
1510			$flg=$copybit;
1511		}
1512		$size='' if !$size;
1513		$flg=0 if !$flg;
1514		$copyflg=($flg & $copybit);
1515		$sizeflg=($flg & $sizebit);
1516		$keepflg=($flg & $keepbit);
1517		my ($pruletype)="";
1518		$pruletype=param("rules.ruletype.$linecount") if param("rules.ruletype.$linecount");
1519                # if delete or not valid data in fields, skip rule (delete it)
1520#		if (($pruletype=~/^delete/i) || ($ruletype=~/delete/i) || (!($to || $from || $subject ||  $size || ($fieldname && $fieldval) || $pruletype)) ) {
1521#			$linecount++;
1522#			next;
1523#
1524#		}
1525		if ($pruletype=~/^delete/i || $ruletype=~/delete/i ) {
1526			$linecount++;
1527			next;
1528		}
1529		my ($pr1,$rt1)="";
1530		if (defined(param("rules.priority.$linecount"))) {
1531
1532                	$pr1 =param("rules.priority.$linecount");
1533                	$rt1 =param("rules.ruletype.$linecount");
1534		}
1535		else {
1536			$rt1=$ruletype;
1537			$pr1 =$priority;
1538		}
1539
1540                $rt1=~s/ +//g;
1541                $pr1=~s/ +//g;
1542		$size=~/([0-9kK]+)/;
1543		$size=$1;
1544		$size='' if !$size;
1545                #check for valid data passed in form (ruletype and priority)
1546                #if not use original values from saved script
1547
1548                if (($pr1!~/\W+/) && ($pr1=~/\d+/)) {
1549                        $priority=$pr1;
1550		}
1551		#check for valid ruletype passed in form
1552
1553		#print "rt1=$rt1, ruletype=$ruletype<br>";
1554		if ($rt1=~/\W+/ ) {
1555			$rtype=$ruletype;
1556		}
1557		else {
1558                        $rtype=$rt1;
1559
1560		}
1561		if (!$rtype) {
1562                        $rtype="DISABLED";
1563		}
1564		$rule=$priority.$delimiter.$rtype.$delimiter.$from.$delimiter.$to.$delimiter.$subject.$delimiter.$destt.$delimiter.$dest.$delimiter.$flg.$delimiter.$fieldname.$delimiter.$fieldval.$delimiter.$size."\n";
1565
1566                # save checked rule  and increment linecount
1567		push (@rulea,$rule);
1568		$linecount++;
1569
1570	} # while
1571
1572	$linecount=param("rulescount");
1573# start checking new rule entry for validity and parse it
1574# New or modified rule is checked here
1575# this loop should only run once
1576
1577	while ($linecount==param("rulescount")){
1578                # check for valid data - else skip rule
1579		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")) {
1580
1581			$linecount++;
1582			next;
1583		}
1584		$destt=param("rules.desttype.$linecount");
1585		if ($destt=~/folder/i) {
1586			if(param("rules.mailbox.$linecount")!~/\S/) {
1587				$linecount++;
1588				next;
1589			}
1590			$dest=param("rules.mailbox.$linecount");
1591
1592		}
1593		elsif ($destt=~/address/i) {
1594			if(param("rules.forward.$linecount")!~/\S/) {
1595				$linecount++;
1596				next;
1597			}
1598			$dest=param("rules.forward.$linecount");
1599		}
1600		elsif ($destt=~/reply/i) {
1601			if(param("rules.reply.$linecount")!~/\S/) {
1602				$linecount++;
1603				next;
1604			}
1605			$dest=param("rules.reply.$linecount");
1606                        $dest=~s/\n/\\n/g;
1607			$dest=~s/\r//g;
1608		}
1609		elsif ($destt=~/custom/i) {
1610			if(param("rules.custom.$linecount")!~/\S/) {
1611				$linecount++;
1612				next;
1613			}
1614			$dest=param("rules.custom.$linecount");
1615                        $dest=~s/\n/\\n/g;
1616			$dest=~s/\r//g;
1617		}
1618
1619		elsif ($destt=~/reject/i) {
1620			if(param("rules.reject.$linecount")!~/\S/) {
1621				$linecount++;
1622				next;
1623			}
1624			$dest=param("rules.reject.$linecount");
1625                        $dest=~s/\n/\\n/g;
1626			$dest=~s/\r//g;
1627		}
1628
1629		else {
1630			$dest='';
1631		}
1632		$copyflg='';
1633		$keepflg='';
1634#		$copyflg=param("rules.copy.$linecount");
1635		my @checked=param("rules.copy.$linecount");
1636		$copyflg=$copybit if (grep /copy/i, @checked);
1637		$keepflg=$keepbit if (grep /keep/i, @checked);
1638		$regexflg=$regexbit if (grep /regex/i,@checked);
1639
1640#		$regexflg=param("rules.regex.$linecount");
1641		if (param("rules.sizeflg.$linecount")) {
1642			$sizeflg=$sizebit;
1643		} else {
1644			$sizeflg=0;
1645		}
1646
1647
1648		if (param("rules.searchflg.$linecount")) {
1649			$searchflg=$searchbit;
1650		}
1651		else {
1652			$searchflg=0;
1653		}
1654		if (!$sizeflg) {$sizeflg=0};
1655		if (!$copyflg) {$copyflg=0};
1656		if (!$regexflg) {$regexflg=0};
1657		if (!$keepflg) {$keepflg=0};
1658
1659		$flg=$keepflg | $copyflg | $searchflg | $regexflg | $sizeflg; # OR other flgs here
1660                $onerule=param("rules.priority.$linecount").$delimiter."ENABLED".$delimiter.param("rules.from.$linecount").$delimiter.param("rules.to.$linecount").$delimiter.param("rules.subject.$linecount").$delimiter.
1661param("rules.desttype.$linecount").$delimiter.$dest.$delimiter.$flg.$delimiter.param("rules.fieldname.$linecount").$delimiter.param("rules.fieldval.$linecount").$delimiter.param("rules.size.$linecount")."\n";
1662		$linecount++;
1663	}#while
1664        push (@rulea,$onerule) if $onerule;
1665	@rulea=sort {($a=~/(\d+)/)[0] <=>  ($b=~/(\d+)/)[0]} @rulea;
1666	$rulelist="@rulea";
1667        if ($rulesorig ne $rulelist) {
1668		return $rulelist;
1669	}
1670
1671	return "";
1672}
1673
1674sub checkvacation {
1675	my (@tmp,$tmp,$t1,$t2);
1676
1677	if (!defined param('vacationmode')) {
1678		$tmp=$vacation{'addresses'};
1679	}
1680	else {
1681        	$vacation{'days'}=param('vacationdays');
1682		$tmp=param('vacaddresses');
1683		$vacation{'mode'}=param('vacationmode');
1684       		$vacation{'text'}=param('vacationtext');
1685
1686
1687	}
1688	$tmp=~s/\"//g;
1689	$tmp=~s/\@/\\@/g;
1690	$tmp=~s/\r//g;
1691 	$tmp=~s/,+|:+|;+|\n/ /g;
1692	$tmp=~s/ +/ /g;
1693
1694	$vacation{'addresses'}=$tmp;
1695	if ($vacation{'addresses'}) {
1696		$vacation{'addresses'}=~s/\\@/\@/g;
1697		@tmp=split(",| +",$vacation{'addresses'});
1698
1699		while (@tmp) {
1700			$t1.=', ' if $t1;
1701			$t1.="\"".shift(@tmp)."\"";
1702		}
1703		$vacation{'addresses'}=$t1 if $t1;
1704	}
1705
1706
1707	$vacation{'addresses'}="\"$uid\@$maildomain\", \"$uid\@$mailhostappend\"" if ($vacation{'addresses'}!~/\w+/);
1708	$vacation{'days'}="1" if ($vacation{'days'}!~/\d/);
1709        return;
1710}
1711
1712
1713
1714sub gomodifyit
1715{
1716my (%tmpscr,$mode,@pseudo,$tmp,$modchange,$pseudonew,$delete,$save,$pseudo,$err);
1717
1718# process the sieve or procmail pseudo rulesets
1719	$change=0;
1720	$err='';
1721	if (param('Refresh')) {
1722		print "Screen Refreshed";
1723		return;
1724	}
1725        %tmpscr=%scripts;
1726	$oldscript=$tmpscr{'script'};
1727	$scriptname=$tmpscr{'scriptname'};
1728	$scriptdef=$tmpscr{'scriptdef'};
1729	$script=param('script');
1730	$oldmode=$tmpscr{'oldmode'};
1731	$mode=param('mode');
1732	$pseudo=$tmpscr{'pseudo'};
1733	$delete=$tmpscr{'deletescript'};
1734	# from auth.pl
1735	$res.=&auth_changepass if $useauth;
1736	return if $op eq 'setpass';
1737	&modifyacl if ($useacl && $op eq 'setacl');
1738	return if $op eq 'setacl';
1739	print hr;
1740	if ($delete && !$useprocmail) {
1741		&opensieve($uid,$pass,$sieveport,$imapserver) if !$sieve;
1742		if ($scriptdef!~/yes|on|active/i && $viewscript eq $scripts{'active'}) {
1743		$res.=&setactive("");
1744 		}
1745
1746		$res.=&deletescript($delete);
1747		if ($res) {
1748	      		print "\n",br,"<b>Delete Script Error:</b> $res...\n",br;
1749			return;
1750	 	}
1751		return;
1752	}
1753	if ($scriptdef!~/yes|on|active/i && $viewscript eq $scripts{'active'} && !$useprocmail) {
1754		$res.=&setactive("");
1755 	}
1756
1757	&checkvacation if ($usevacation || $usereply);
1758	if (($oldmode ne $mode) && (param('viewscript') eq param('lastviewscr'))) {
1759			$modchange=1;
1760			print "<b>Warning! Now in $mode mode...<br></b>" if $mode;
1761			print "<b>Any changes made in advanced mode have now been overwritten.<br></b>" if $mode eq 'basic';
1762			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'
1763		}
1764#print "mode=$mode oldmode=$oldmode<br>";
1765	 # check if viewing new script - no save then
1766       if (param('viewscript') eq param('lastviewscr')) {
1767	if ($mode =~ /basic/i || $modchange) {
1768
1769		$rules=&checkrules;
1770		if ($useprocmail) {
1771			my $prules;
1772			my @rules=split(/\n/,$rules);
1773			while ($_=shift(@rules)) {
1774				$prules.="#rule&&".$_."\n";
1775			}
1776			$change=1;
1777			my $vtext=$vacation{'text'};
1778			$vtext=~s/\n/\\n/g;
1779			$vtext=~s/\r//g;
1780
1781			$prules.="#vacation&&".$vacation{'days'}."&&".$vacation{'addresses'}."&&".$vtext."&&".$vacation{'mode'}."\n";
1782			$prules.="#mode&&basic\n";
1783			 &auth_saveattrib($matchingrules,$prules) if defined &auth_saveattrib;
1784			 &mailruleupd($uid);
1785
1786                  }
1787		   elsif ($res.=&updatesieve($rules,%tmpscr)) {
1788		      print "\n",br,"<b>Updatesieve Error:</b> Cant' update script...",br;
1789	      print "<b>Returned Error:</b> $res $SIEVEERROR<br>";
1790	      print "You can click on your browser's  <b>Back</b> button to ";
1791		      print "go back and try your entry again.<br>";
1792#		      return;
1793			print hr;
1794			&byline;
1795			exit;
1796
1797		   }
1798	}
1799	else {
1800		$script=$oldscript if (!$script && $scriptdef !~/yes|on|active/i);
1801
1802		if ($script && ($script=~/\w+/) && ($scriptname))  {
1803			@pseudo=split("\n",$pseudo);
1804			while (@pseudo) {
1805				$tmp=shift(@pseudo);
1806				$tmp=~s/^ *#mode.*$//ig;
1807				next if ($tmp!~/\S/);
1808				$pseudonew.=$tmp."\n";
1809
1810			}
1811			$vacation{'text'}=~s/\n/\\n/g;
1812			$vacation{'text'}=~s/\r//g;
1813			$pseudonew.="\n#mode&&advanced\n";
1814			if (($script ne $oldscript) || ($pseudo ne $pseudonew) || ($scriptname ne $tmpscr{'viewscript'}) || $mode ne $oldmode) {
1815				$change=1;
1816				&opensieve($uid,$pass,$sieveport,$imapserver) if !$sieve;
1817				#$script.="\n".$pseudonew;
1818				$script=~s/\r\n/\n/mg;
1819				$res.=&putscript($scriptname,$script);
1820				$res.=&putscript($scriptname."_pseudo",$pseudonew);
1821
1822			}
1823
1824	      } # if script =~/\w
1825		if ($scriptdef=~/yes|on|active/i && $scriptname && !$useprocmail) {
1826			&opensieve($uid,$pass,$sieveport,$imapserver) if !$sieve;
1827               		$res.=&setactive($scriptname);
1828			print "Script $scriptname now active.. <br>";
1829
1830	       	}
1831
1832	}
1833       } # if param(viewscript)
1834       else {
1835		param('scriptdef','off');
1836	}
1837#  Success!
1838        if (!$res ) {
1839                print "<b>Update successful...</b>" if $change;
1840		print "<b>No changes..</b>" if !$change;
1841                return;
1842	}
1843        else {
1844            print "<b>Failure<br>Returned Error:</b> $res <br>";
1845	     return;
1846
1847	}
1848}
1849
1850
1851sub updatesieve {
1852        my ($filterval,%scripts) =@_;
1853	$scriptdef=$scripts{'scriptdef'};
1854	$scriptname=$scripts{'scriptname'};
1855	if (!$scriptname) {
1856		$scriptname=$scripts{'viewscript'};
1857	}
1858	my (@mbxlist,$rulesyes,$vacationyes,$usereject);
1859my %fields=(
1860	"subject",'"subject" ',
1861	"to",'["Cc","CC","To","TO"] ',
1862 	"contain",':contains ',
1863	"from",'["from"] ',
1864	"address",'redirect ',
1865	"folder",'fileinto ',
1866	"reject",'reject ',
1867	"reply",'vacation :days '.$vacation{'days'}.' ',
1868	"discard",'discard '
1869
1870	);
1871	my %matchtype=(
1872		"0","allof",
1873		$searchbit,"anyof"
1874		);
1875
1876#	$fields{'contain'}=':matches ' if ($usematches);
1877        my (@lrules)=split('\n',$filterval);
1878	my ($keep,$copyrules,$copystat,$procreq,$procr,$extradefs) = "";
1879	my $proch="";
1880	my $proc="";
1881	my $not="";
1882	$copystat="";
1883	$usereject=0;
1884	$procr="";
1885	$copyrules="";
1886	$procreq="";
1887	$rulesyes=0;
1888	$vacationyes=0;
1889	my ($fieldn,$field,$wc);
1890	my $regexused;
1891	my $noelse;
1892        while (@lrules) {
1893		my $tmp='';
1894                $line=shift(@lrules);
1895		chomp($line);
1896		my ($priority,$ruletype,$from,$to,$subject,$desttype,$dest,$flg,$fieldname,$fieldval,$size) = split("&&",$line);
1897		next if !$desttype;
1898		$procr.="#rule&&"."$line\n";
1899		$dest=~s/\r//g;
1900		$dest=~s/\\n/\r\n/g;
1901		if ($flg=~/copy/i) {
1902			$copyflg=$copybit;
1903		}
1904		else {
1905			$copyflg= ($flg & $copybit);
1906		}
1907		$keep="";
1908		$matchflg=($flg & $searchbit);
1909		$keepflg=($flg & $keepbit);
1910		$keepflg=0 if (!$keepflg);
1911		$matchflg=0 if (!$matchflg);
1912		$sizeflg=($flg & $sizebit);
1913		$sizeflg=0 if (!$sizeflg);
1914		$regexflg=($flg & $regexbit);
1915		$regexused ||=$regexflg;
1916#		if ((!($to|$from|$subject|($fieldname && $fieldval)) | !$fields{$desttype}) && (!($dest && $desttype eq 'custom')) && !$dest) {next};
1917		if ($ruletype !~/ENABLED|\d/i) {next};
1918		$keep="     keep;\n" if $keepflg;
1919	     	if ($desttype=~/folder/i) {
1920			#@mbxlist=&listmailbox("user.$uid.$dest");
1921			#if (!@mbxlist) {
1922			#	print "Folder $uid.$dest does not exist ..\n";
1923			#	next};
1924			next if !$dest;
1925			$dest=~s/^INBOX.INBOX/INBOX/;
1926			if (($dest =~/^INBOX/)||($alt_namespace)) {
1927				$msgdest=$dest;
1928			}
1929			else   {
1930				$msgdest="INBOX.$dest";
1931			}
1932			# check if folder is in an addtional namespace
1933			foreach $namespace (@namespaces) {
1934				if ($dest=~/^$namespace./i) {
1935					$msgdest="$dest";
1936					last; # stop checking
1937				}
1938			}
1939		}
1940		elsif ($desttype=~/address|reply|reject/i) {
1941			$msgdest=$dest;
1942			if ($desttype=~/address/i && $dest!~/\w+\@\w+\.\w+/) {
1943				next;
1944			}
1945			$usereject=1 if $desttype=~/reject/i;
1946			$vacationyes=1 if $desttype=~/reply/i;
1947			if (($keepredirect ) && ($desttype=~/address/i)) {
1948				$keep="     keep;\n";
1949			}
1950			next if !$dest;
1951
1952		}
1953		else {$msgdest='';}
1954		$rulesyes=1;
1955
1956		if ($copyflg==$copybit) {
1957			$copystat='';
1958		}
1959		else {
1960			$copyflg='';
1961		}
1962		$fieldn='0';
1963		$field='';
1964		$wc='';
1965		$fields{'contain'}=':matches ' if ($usematches);
1966		$not='';
1967
1968		if ($to) {
1969		    if ($regexflg) {
1970		    	$fields{'contain'}=':regex ';
1971			$wc='';
1972		    }
1973		    else {
1974
1975			if ($to=~/\*|\?/) {
1976				$fields{'contain'}=':matches ';
1977				$wc='*' if (!$usematches);
1978			}
1979			elsif (!$usematches) {
1980				$fields{'contain'}=':contains ';
1981				$wc='';
1982			}
1983		    }
1984			$not="not " if $to=~s/^\s*!//;
1985			$field.=$not."address ".$fields{'contain'}.$fields{'to'}."\"$wc$to$wc\"";
1986			$fieldn++;
1987		}
1988		$not='';
1989		if ($from) {
1990		    if ($regexflg) {
1991		    	$fields{'contain'}=':regex ';
1992			$wc='';
1993		    }
1994		    else {
1995
1996			if ($from=~/\*|\?/) {
1997				$fields{'contain'}=':matches ';
1998				$wc='*' if (!$usematches);
1999			}
2000			elsif (!$usematches) {
2001				$fields{'contain'}=':contains ';
2002				$wc='';
2003			}
2004
2005		    }
2006
2007			$not="not " if $from=~s/^\s*!//;
2008
2009			if ($field) {$field.=", ";}
2010			$field.=$not."address ".$fields{'contain'}.$fields{'from'}."\"$wc$from$wc\"";
2011
2012			$fieldn++;
2013
2014		}
2015		$not='';
2016		if ($subject) {
2017		    if ($regexflg) {
2018		    	$fields{'contain'}=':regex ';
2019			$wc='';
2020		    }
2021		    else {
2022
2023			if ($subject=~/\*|\?/) {
2024				$fields{'contain'}=':matches ';
2025				$wc='*' if (!$usematches);
2026			}
2027			elsif (!$usematches) {
2028				$fields{'contain'}=':contains ';
2029				$wc='';
2030			}
2031
2032		    }
2033
2034			$not="not " if $subject=~s/^\s*!//;
2035
2036			if ($field) {$field.=", ";}
2037			$field.=$not."header ".$fields{'contain'}.$fields{'subject'}."\"$wc$subject$wc\"";
2038			$fieldn++;
2039
2040		}
2041		$not='';
2042		if ($size) {
2043		    	$fields{'contain'}=':under ';
2044		    	$fields{'contain'}=':over ' if $sizeflg;
2045			$not="not " if $size=~s/^\s*!//;
2046			my $kb='K';
2047			$kb='K' if $size=~s/k//gi;
2048			$size=~/([0-9]+)/;
2049			$size=$1;
2050			$size='' if !$size;
2051			if ($field) {$field.=", ";}
2052			$field.=$not."size ".$fields{'contain'}.$size.$kb;
2053			$fieldn++;
2054		}
2055
2056		$not='';
2057		if ($fieldname && $fieldval) {
2058		    if ($regexflg) {
2059		    	$fields{'contain'}=':regex ';
2060			$wc='';
2061		    }
2062		    else {
2063			if ($fieldval=~/\*|\?/) {
2064				$fields{'contain'}=':matches ';
2065				$wc='*' if (!$usematches);
2066			}
2067			elsif (!$usematches) {
2068				$fields{'contain'}=':contains ';
2069				$wc='';
2070			}
2071
2072		    }
2073			$not="not " if $fieldval=~s/^\s*!//;
2074
2075			if ($field) {$field.=", ";}
2076			$field.=$not."header ".$fields{'contain'}." \"".$fieldname."\""." \"$wc$fieldval$wc\"";
2077
2078			$fieldn++;
2079
2080		}
2081
2082		if ($desttype=~/reply/i) {
2083			$extradefs=":addresses [$vacation{'addresses'}] ";
2084		}
2085		else { $extradefs="";}
2086
2087		if ($desttype=~/reply|reject/i) {
2088			$msgdest="text:\r\n".$msgdest."\r\n\.\r\n" if $msgdest;
2089		}
2090		else {
2091			$msgdest="\"".$msgdest."\"" if $msgdest;
2092		}
2093#		print "copystat=$copystat matchtype=$matchtype{$matchflg} fields=$field fields2=$fields{lc($desttype)} extra=$extradefs msgdest=$msgdest keep=$keep<br>";
2094		if (!($to || $from || $subject || $size || $fieldname || $fieldval ) && $desttype ne 'custom') {
2095			$tmp=$fields{lc($desttype)}.$extradefs.$msgdest.";\n$keep\n\n" if ($desttype && $msgdest);
2096			$noelse=1;
2097			$copystat='';
2098			$copyflg=$copybit;
2099		}
2100		elsif ($desttype eq 'custom') {
2101			$tmp=$dest."\n\n";
2102			if ($tmp!~s/^\s*if /if /i && $tmp!~s/^\s*elsif /if /i) {
2103				$noelse=1;
2104				$copyflg=$copybit;
2105			}
2106			else {
2107				$tmp=$copystat.$tmp;
2108				$noelse='';
2109			}
2110
2111		}
2112		else {
2113			$copystat='' if ($noelse || $copyflg);
2114			$tmp=$copystat."if ".$matchtype{$matchflg}." \($field\) {\n     ".$fields{lc($desttype)}.$extradefs.$msgdest.";\n$keep}\n\n";
2115			$noelse='';
2116		}
2117#		print $proc;
2118
2119		if (!$copyflg)  {
2120			$proc.=$tmp;
2121		}
2122		else {
2123			$copyrules.=$tmp;
2124		}
2125		$copystat='els' if $proc;
2126		$change=1;
2127	} #while @lrules
2128	$vacationyes=1 if ($vacation{'mode'}=~/on|active|yes|1/i);
2129	$proch="# Mail rules for user $uid\n# Created by Websieve version $version\n";
2130	if ($rulesyes | $vacationyes | $usereject | $regexused) {
2131
2132
2133		$procreq="require [\"fileinto\"";
2134
2135		if ($vacationyes) {
2136
2137			$procreq.=",\"vacation\"";
2138		}
2139		if ($usereject) {
2140			$procreq.=",\"reject\"";
2141
2142		}
2143		if ($regexused) {
2144			$procreq.=",\"regex\"";
2145		}
2146		$procreq.="];\n\n";
2147	}
2148
2149
2150	$proc=$proch.$procreq.$copyrules.$proc;
2151	$proc.="else {\n     keep;\n}\n\n" if ($rulesyes && !($op eq 'forward') && !$noelse) ;
2152
2153	if($vacation{'mode'}=~/on|active|yes|1/i) {
2154		# this forces the script active when vacation is on
2155		$scriptdef='on' if $mode ne 'advanced';
2156#		print "vacation=".$vacation{'text'}."<br>";
2157		$vacation{'text'}=~s/\\n/\r\n/g;
2158       		 $vacation{'addresses'}=~s/\n/,/g;
2159		 if ($vacation{'text'} && $vacation{'days'}) {
2160#			print "Sieve vacation active<br>";
2161#			print "\nvacation :days ".$vacation{'days'}." :addresses [".$vacation{'addresses'}."] "."text:\r\n".$vacation_prelude.$vacation{'text'}."\r\n\.\r\n".";\n";
2162
2163			$proc.="\nvacation :days ".$vacation{'days'}." :addresses [".$vacation{'addresses'}."] "."text:\r\n".$vacation_prelude.$vacation{'text'}."\r\n\.\r\n".";\n";
2164
2165			$rulesyes=1;
2166   		}
2167		else {
2168			$vacation{'mode'}='off';
2169		}
2170
2171	}
2172	if (!$rulesyes ) {
2173                $proc=$proch;
2174		$rulesyes=1;
2175        }
2176
2177
2178	$change=1;
2179	if ($rulesyes) {
2180		&opensieve($uid,$pass,$sieveport,$imapserver) if !$sieve;
2181		$pseudo.="\n\n##PSEUDO script start\n".$procr; # append #rule lines to end of script
2182		# append vacation pseudo lines
2183		$vacation{'text'}=~s/\n/\\n/g;
2184	#	$vacation{'addresses'}=~s/\"//g;
2185		$vacation{'text'}=~s/\r//g;
2186		$pseudo.="#vacation&&".$vacation{'days'}."&&".$vacation{'addresses'}."&&".$vacation{'text'}."&&".$vacation{'mode'}."\n" if $usevacation;
2187		$pseudo.="#mode&&$mode\n";
2188		&auth_saveattrib($matchingrules,$pseudo) if ($updatepseudo && defined &auth_saveattrib);
2189
2190		#$proc.=$pseudo;
2191		#print "name=$scriptname<br>proc=$proc"; # debug
2192#		&savetext($scriptname,$proc);	 # debug test
2193		&putscript($scriptname,$proc);
2194		if (&putscript($scriptname."_pseudo",$pseudo)) {
2195		    if ($SIEVEERROR =~ /exist/i) {
2196		    		return '';
2197		    }
2198		    else {
2199		    	return $SIEVEERROR;
2200		    }
2201
2202                }
2203		if($vacation{'mode'}=~/on|active|yes|1/i) {
2204			print "Sieve vacation active<br>";
2205		}
2206
2207		if ($scriptdef && $scriptdef=~/yes|on|active/i && !$useprocmail) {
2208			print "Script $scriptname active.. <br>";
2209               		$res=&setactive($scriptname);
2210			return $SIEVEERROR if $res;
2211	       }
2212
2213	       return;
2214        } # if rulesyes
2215
2216}
2217
2218sub printvacation {
2219	my ($tmpvacadd);
2220
2221	$tmpvacadd=$vacation{'addresses'};
2222     %modevals = (
2223	"on","Yes",
2224	"off","No");
2225	$vacation{'text'}=~s/\\n/\r\n/g;
2226
2227
2228    			print hr,"<TABLE border=1 width=100%><TR $cb><TD $tb>";
2229   			print "<b><center>Vacation Mode status for:</b> $uid","</center></TD><TR $cb><TD>";
2230
2231			print "<TABLE>";
2232                        param("vacationmode",$vacation{'mode'});
2233                        print "<TR><TD $cb><b>Vacation Active?:</b></TD> <TD $cb>",radio_group("vacationmode",['off','on'],$vacation{'mode'},'',\%modevals),"</TD></TR>\n";
2234                        param("vacationtext",$vacation{'text'});
2235                        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";
2236		      if (!$useprocmail) {
2237                        param("vacationdays",$vacation{'days'});
2238                        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";
2239                        param("vacaddresses",$tmpvacadd);
2240                        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";
2241		      } # if !$useprocmail
2242print "</TD></TABLE></TABLE>";
2243}
2244
2245
2246sub createmailfolder {
2247	my ($mbx,$partition)=@_;
2248	my @list=&listmailbox($mbx);
2249	my $err;
2250	if (!(@list)) {
2251	  $err=&createmailbox($mbx,$partition);
2252	}
2253	else {
2254		$err="$mbx already exists!";
2255	}
2256	if ($err) {
2257		return $err;
2258	}
2259	print "$mbx created successfully. <br>";
2260	 return "";
2261}
2262
2263#############################################
2264 sub encode_list {
2265      return undef unless @_;
2266      my $out='';
2267      foreach (@_) {
2268         $out .= 'G'.pack('c', 65 + int(rand(6))) if $out;
2269         $out .= reverse(uc(unpack('H'.(length)*2, $_))) if $_;
2270      }
2271      return $out.'='; # looks like some recognizable format
2272 }
2273
2274 sub decode_list {
2275     return undef unless $_[0];
2276     my @out;
2277     foreach ( split(/G[A-F]/, substr($_[0],0,-1)) ) {
2278         push @out, pack('H'.(length), scalar reverse $_);
2279     }
2280      return @out;
2281 }
2282
2283
2284##############################################
2285
2286# Encryption routines for cookie
2287
2288# from EZCrypt v2.0 (c) 2000 Croesus Design and Promotion
2289# Developed by Jason C. Fleming
2290# Base64 routines Copyright 1995-1997 Gisle Aas.
2291# This library is free software; you can redistribute it and/or
2292# modify it under the same terms as Perl itself.
2293
2294sub Encrypt {
2295my ($plaintext,$key) = @_; #get message and key from user
2296    if (!$key) {
2297    	print "\$skey not set!!! <br>";
2298    }
2299    my ($cr,$index,$char,$key_char,$encrypted);
2300    $plaintext = &rot13($plaintext); #garble source by swapping alphabet
2301    $cr = '``'; #carriage return character unlikely to occur in text
2302    $plaintext =~ s/[\n\f\t]//g; #remove whitespace chars
2303    $plaintext =~ s/[\r]/$cr/g; #swap cr with our token
2304    while ( length($key) < length($plaintext) ) { $key .= $key } #pad private key
2305    $key=substr($key,0,length($plaintext)); #set key to same length as source
2306    $index=0;
2307    while ($index < length($plaintext)) { #go through each character and swap bits with key
2308        $char = substr($plaintext,$index,1);
2309        $key_char = substr($key,$index,1);
2310        $encrypted .= chr(ord($char) ^ ord($key_char)); #THE MEAT OF THE ENCRYPTION
2311        $index++;
2312    }
2313    $encrypted = encode_base64($encrypted); #convert xor encrypted string into printable blocks
2314    $encrypted; #send the cyphertext back to user
2315}
2316
2317sub Decrypt {
2318    my ($encrypted, $key) = @_;
2319    $encrypted = decode_base64($encrypted); #convert encrypted blocks into xor code
2320    my ($cr,$index,$char,$key_char,$decrypted);
2321    while ( length($key) < length($encrypted) ) { $key .= $key } #pad key
2322    $key=substr($key,0,length($encrypted)); #set key to same length as source
2323    $index=0;
2324    while( $index < length($encrypted) ) { #swap bits with key
2325        $char = substr($encrypted,$index,1);
2326        $key_char = substr($key,$index,1);
2327        $decrypted .= chr(ord($char) ^ ord($key_char)); #THE MEAT OF THE ENCRYPTION
2328        $index++;
2329    }
2330    $cr = '``';
2331    $decrypted =~ s/$cr/\r/g;#replace carriage returns
2332    my $list=&rot13( $decrypted ); #unswap alphabet
2333
2334}
2335
2336sub rot13{ #swaps low letters (a-m) with high letters (n-z) and visa versa
2337    my $source = shift (@_);
2338    $source =~ tr /[a-m][n-z]/[n-z][a-m]/; #performs rot13 swapping (lc)
2339    $source =~ tr /[A-M][N-Z]/[N-Z][A-M]/;#performs rot13 swapping (caps)
2340    $source = reverse($source);
2341    $source;
2342}
2343
2344sub encode_base64 {
2345    my $res = "";
2346    my $eol = $_[1];
2347    $eol = "\n" unless defined $eol;
2348    pos($_[0]) = 0;                          # ensure start at the beginning
2349    while ($_[0] =~ /(.{1,45})/gs) {
2350    $res .= substr(pack('u', $1), 1);
2351    chop($res);
2352    }
2353    $res =~ tr|` -_|AA-Za-z0-9+/|;               # `# help emacs
2354    # fix padding at the end
2355    my $padding = (3 - length($_[0]) % 3) % 3;
2356    $res =~ s/.{$padding}$/'=' x $padding/e if $padding;
2357    # break encoded string into lines of no more than 76 characters each
2358    if (length $eol) {
2359    $res =~ s/(.{1,76})/$1$eol/g;
2360    }
2361    $res;
2362}
2363
2364sub decode_base64{
2365    local($^W) = 0; # unpack("u",...) gives bogus warning in 5.00[123]
2366
2367    my $str = shift;
2368    my $res = "";
2369
2370    $str =~ tr|A-Za-z0-9+=/||cd;            # remove non-base64 chars
2371    #if (length($str) % 4) {die "Base64 decoder requires string length to be a multiple of 4"}
2372    $str =~ s/=+$//;                        # remove padding
2373    $str =~ tr|A-Za-z0-9+/| -_|;            # convert to uuencoded format
2374    while ($str =~ /(.{1,60})/gs) {
2375    my $len = chr(32 + length($1)*3/4); # compute length byte
2376    $res .= unpack("u", $len . $1 );    # uudecode
2377    }
2378    $res;
2379}
2380
2381#  end of encrypt routines
2382
2383### only used in debugging #####
2384
2385sub savetext {
2386	my ($filename,$filetext)=@_;
2387	open OUT,">/tmp/$filename";
2388	print OUT $filetext;
2389	close OUT;
2390}
2391sub URLEncode
2392{
2393    my($url)=@_;
2394    my(@characters)=split(/(\%[0-9a-fA-F]{2})/,$url);
2395    foreach(@characters)
2396    {
2397	if ( /\%[0-9a-fA-F]{2}/ ) # Escaped character set ...
2398	{
2399	    unless ( /(20|7f|[0189a-fA-F][0-9a-fA-F])/i
2400		    || /2[2356fF]|3[a-fA-F]|40/i )
2401	    {
2402		s/\%([2-7][0-9a-fA-F])/sprintf "%c",hex($1)/e;
2403	    }
2404	}
2405	else # Other stuff
2406	{
2407	    s/([\000-\040\177-\377\074\076\042\+])
2408	     /sprintf "%%%02x",unpack("C",$1)/egx;
2409	}
2410    }
2411    return join("",@characters);
2412}
2413# RC4 perl encryption routine by Andy Welter May 2001
2414# Encrypt a buffer at a type.  Encryption is a stateful
2415# process, so we use the "@state" global variable to track
2416# the state.
2417sub rc4 {
2418my ($buf) = @_;
2419my ($ebuf, $char);
2420my $x=0;
2421my $y=0;
2422
2423for(unpack('C*',$buf)) {
2424	$x++;
2425	$y=($state[$x%=256]+$y)%256;
2426	@state[$x,$y]=@state[$y,$x];
2427	$char= pack (C,
2428		$_^=$state[ ($state[$x] + $state[$y]) %256 ]);
2429	$ebuf= $ebuf . $char;
2430	};
2431return $ebuf;
2432};
2433
2434sub prepkey {
2435#
2436# Prepare the encryption key
2437#
2438my ($key)=@_;
2439my @hexkey=unpack('C*',$key);
2440my ($x, $y)=("0","0");
2441my @t;
2442my @state;
2443for(@t=@state=0..255){
2444	$y=($hexkey[$_%@hexkey]+$state[$x=$_]+$y)%256;
2445	@state[$x,$y]=@state[$y,$x];
2446	#&swap;
2447}
2448return @state;
2449};
2450
2451sub encrypt_rc4 {
2452	my ($key,$buf)=@_;
2453	local @state=&prepkey($key);
2454	return &rc4($buf);
2455};
2456sub tablebutton
2457{
2458	my ($text) = @_;
2459	return "<table border=1><tr><td BGCOLOR=\#9999FF><B><center>".$text."</center></B></td></tr></table>\n";
2460}
2461# this function will take a user's mail server host name and retrieve all port
2462# and host data to connect to it if not default.
2463
2464sub getserverdata {
2465	my ($userserver)=@_;
2466	  $imapserver=$userserver if $userserver;
2467	  if (defined $server_hosts{$userserver}) {
2468	  #	$serverdisplay=$server_hosts{$userserver}[0] if $server_hosts{$userserver}[0];
2469		$imapport=$server_hosts{$userserver}[1] if $server_hosts{$userserver}[1];
2470		$sieveport=$server_hosts{$userserver}[2] if $server_hosts{$userserver}[2];
2471		$maildomain=$server_hosts{$userserver}[3] if $server_hosts{$userserver}[3];
2472		$mailhostappend=$server_hosts{$userserver}[4] if $server_hosts{$userserver}[4];
2473		my $sslopts=$server_hosts{$userserver}[5];
2474		if ($sslopts) {
2475			$useimapSSL=1 if ($sslopts=~/imap|both|all|^ssl$/i);
2476			$usesieveSSL=1 if ($sslopts=~/sieve|both|all|^ssl$/i);
2477		}
2478
2479	  }
2480	  return ($imapserver);
2481}
2482
2483sub confirmmbxdelete {
2484    if( !$ismanager ) {
2485        print "<b>Access not allowed</b><br>";
2486        return;
2487    }
2488    $mbx=param('delmailbox');
2489    return if !$mbx;
2490    if ($mbx=~/\*/) {
2491    	print "<B>Warning! You are attempting a wildcard delete !!! Not allowed!</b><br>";
2492	return;
2493    }
2494    param('delmailbox',$mbx);
2495    param( 'action', 'deletembx' );
2496    print hidden('delmailbox');
2497    print hidden('mbx');
2498    print "<CENTER><BR><H4> Confirm: Really delete $mbx from server $imapserver</H4><BR>";
2499    print "<BR><CENTER>",submit("Confirm Delete"),"</CENTER>";
2500    print "<BR> If so, press the 'Confirm Delete' button.\n";
2501    print "<BR> If not, press the back button in your browser.\n</CENTER>";
2502    return;
2503}
2504
2505sub deleteimapmailbox {
2506
2507    if( !$ismanager ) {
2508        print "<b>Access not allowed</b><br>";
2509        return;
2510    }
2511    $mbx=param('delmailbox');
2512    return if !$mbx;
2513    if ($ismanager ) {
2514	    my $err = setacl( $mbx ,
2515        	              $uid,
2516                	      "lrswipcda"
2517                    	)." <BR> ";
2518    }
2519    $err.=  &deletemailbox($mbx);
2520
2521    if ( $err ) {
2522        print hr,"<b>DeleteMailbox Error:</b> imapdelerr $err";
2523        return;
2524
2525    } else {
2526        print "Mailbox: $mbx  deleted.<BR>";
2527    }
2528
2529}
2530
2531sub mailruleupd {
2532	my ($uid)=@_;
2533	open (MAIL, "|$sendcmd");
2534	print MAIL "From: $fromaddr\n";
2535	print MAIL "To: $toaddr\n";
2536	print MAIL "Subject: Filter activation\n";
2537	print MAIL "X-Customfilter: $uid $adminsecret\n";
2538	print MAIL "\n";
2539	print MAIL "Filter activation message for $uid";
2540	close(MAIL);
2541}
2542