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: 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 " ".submit('Select Folder')." ".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)." ".submit("Select","Select $subtext")." (Wildcards allowed [*])</TD></TR>"; 593 } 594 595 print "<TR><TD $cb ><b>Foreign User ID:</b></TD>"; 596 print "<TD $cb>".textfield("acluser")." (User ID to assign access rights) ".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 " <b>Disk Quota Used (KB):</b> ".$imapquota[1]." ".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")." "; 619 print "<b>Partition: </b>",textfield("partition") if $ismanager; 620 print" ". submit('Create Mailbox',"Create $subtext")." </TR>"; 621 print "<TR><TD $cb ><b>$subtext to Delete:</b></TD><TD $cb>".textfield("delmailbox")." ".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 . " ".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')," ",submit("Refresh")," ",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 " <b>Priority: </b>",textfield("rules.priority.$rulecount",$spriority,2); 1100 print " <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> '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> </TD><TD $cb >"; 1146 print " '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> </TD><TD $cb>"; 1154 print " '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> </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> </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> </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> </TD><TD $cb valign=top><input type=radio $check4 name=rules.desttype.$rulecount value=\"discard\"> Discard </TD><TD $cb> </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 ")," ",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')," ",submit("Refresh")," ",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')," ",submit("Refresh")," ",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')," ",submit("Refresh")," ",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