1# mailbox-lib.pl 2use strict; 3use warnings; 4our (%text, %config, %gconfig, %userconfig); 5our $remote_user; 6our @remote_user_info; 7our $user_module_config_directory; 8our $module_root_directory; 9our $module_name; 10 11BEGIN { push(@INC, ".."); }; 12use WebminCore; 13use Socket; 14&init_config(); 15&switch_to_remote_user(); 16&create_user_config_dirs(); 17do "$module_root_directory/boxes-lib.pl"; 18do "$module_root_directory/folders-lib.pl"; 19 20#open(DEBUG, ">>/tmp/mailbox.debug"); 21 22our $qmail_maildir; 23if ($config{'mail_qmail'}) { 24 $qmail_maildir = &mail_file_style($remote_user, $config{'mail_qmail'}, 25 $config{'mail_style'}); 26 } 27else { 28 $qmail_maildir = "$remote_user_info[7]/$config{'mail_dir_qmail'}"; 29} 30our $address_book = "$user_module_config_directory/address_book"; 31our $address_group_book = "$user_module_config_directory/address_group_book"; 32our $folders_dir = "$remote_user_info[7]/$userconfig{'mailbox_dir'}"; 33our %folder_types = map { $_, 1 } (split(/,/, $config{'folder_types'}), 34 split(/,/, $config{'folder_virts'})); 35our $search_folder_id = 1; 36our $special_folder_id = 2; 37our $auto_cmd = "$user_module_config_directory/auto.pl"; 38our $last_folder_file = "$user_module_config_directory/lastfolder"; 39 40# mailbox_file() 41sub mailbox_file 42{ 43if ($config{'mail_system'} == 0) { 44 return &user_mail_file(@remote_user_info); 45 } 46else { 47 return "$qmail_maildir/"; 48 } 49} 50 51# supports_gpg() 52# Returns 1 if GPG is installed and the module is available 53my $supports_gpg_cache; 54sub supports_gpg 55{ 56if (!defined($supports_gpg_cache)) { 57 $supports_gpg_cache = &has_command("gpg") && 58 &foreign_check("gnupg") && 59 &foreign_available("gnupg") ? 1 : 0; 60 } 61return $supports_gpg_cache; 62} 63 64# decrypt_attachments(&mail) 65# If the attachments on a mail are encrypted, converts them into unencrypted 66# form. Returns a code and message, valid codes being: 0 = not encrypted, 67# 1 = encrypted but cannot decrypt, 2 = failed to decrypt, 3 = decrypted OK 68sub decrypt_attachments 69{ 70# Check requirements for decryption 71my $first = $_[0]->{'attach'}->[0]; 72my ($body) = grep { $_->{'type'} eq 'text/plain' || $_->{'type'} eq 'text' } 73 @{$_[0]->{'attach'}}; 74my $hasgpg = &has_command("gpg") && &foreign_check("gnupg") && 75 &foreign_available("gnupg"); 76if ($_[0]->{'header'}->{'content-type'} =~ /^multipart\/encrypted/ && 77 $first->{'type'} =~ /^application\/pgp-encrypted/ && 78 $first->{'data'} =~ /Version:\s+1/i) { 79 # RFC 2015 PGP encryption of entire message 80 return (1) if (!&supports_gpg()); 81 &foreign_require("gnupg", "gnupg-lib.pl"); 82 my $plain; 83 my $enc = $_[0]->{'attach'}->[1]; 84 my $rv = &foreign_call("gnupg", "decrypt_data", $enc->{'data'}, \$plain); 85 return (2, $rv) if ($rv); 86 $plain =~ s/\r//g; 87 my $amail = &extract_mail($plain); 88 &parse_mail($amail); 89 $_[0]->{'attach'} = $amail->{'attach'}; 90 return (3); 91 } 92 93# Check individual attachments for text-only encryption 94my $a; 95my $cc = 0; 96my $ok = 3; 97foreach my $a (@{$_[0]->{'attach'}}) { 98 if ($a->{'type'} =~ /^(text|application\/pgp-encrypted)/i && 99 $a->{'data'} =~ /BEGIN PGP MESSAGE/ && 100 $a->{'data'} =~ /([\000-\377]*)(-----BEGIN PGP MESSAGE-+\r?\n([\000-\377]+)-+END PGP MESSAGE-+\r?\n)([\000-\377]*)/i) { 101 my ($before, $enc, $after) = ($1, $2, $4); 102 return (1) if (!&supports_gpg()); 103 &foreign_require("gnupg", "gnupg-lib.pl"); 104 $cc++; 105 my $pass = &gnupg::get_passphrase(); 106 my $plain; 107 my $rv = &gnupg::decrypt_data($enc, \$plain, $pass); 108 return (2, $rv) if ($rv); 109 $ok = 4 if ($before =~ /\S/ || $after =~ /\S/); 110 if ($a->{'type'} !~ /^text/) { 111 $a->{'type'} = "text/plain"; 112 } 113 $a->{'data'} = $before.$plain.$after; 114 } 115 } 116return $cc ? ( $ok ) : ( 0 ); 117} 118 119# check_signature_attachments(&attach, &textbody-attach) 120# Checks for a signature attachment, and verifies it. Returns the signature 121# status code and message. 122sub check_signature_attachments 123{ 124my ($attach, $textbody) = @_; 125my ($sigcode, $sigmessage, $sindex); 126if (&has_command("gpg") && &foreign_check("gnupg") && &foreign_available("gnupg")) { 127 # Check for GnuPG signatures 128 my $sig; 129 my $sindex; 130 foreach my $a (@$attach) { 131 $sig = $a if ($a->{'type'} =~ /^application\/pgp-signature/); 132 } 133 if ($sig) { 134 # Verify the signature against the rest of the attachment 135 &foreign_require("gnupg", "gnupg-lib.pl"); 136 my $rest = $sig->{'parent'}->{'attach'}->[0]; 137 $rest->{'raw'} =~ s/\r//g; 138 $rest->{'raw'} =~ s/\n/\r\n/g; 139 ($sigcode, $sigmessage) = 140 &gnupg::verify_data($rest->{'raw'}, $sig->{'data'}); 141 @$attach = grep { $_ ne $sig } @$attach; 142 $sindex = $sig->{'idx'}; 143 } 144 elsif ($textbody && $textbody->{'data'} =~ /(-+BEGIN PGP SIGNED MESSAGE-+\r?\n(Hash:\s+(\S+)\r?\n\r?\n)?([\000-\377]+\r?\n)-+BEGIN PGP SIGNATURE-+\r?\n([\000-\377]+)-+END PGP SIGNATURE-+\r?\n)/i) { 145 # Signature is in body text! 146 my $sig = $1; 147 my $text = $4; 148 &foreign_require("gnupg", "gnupg-lib.pl"); 149 ($sigcode, $sigmessage) = &gnupg::verify_data($sig); 150 if ($sigcode == 0 || $sigcode == 1) { 151 $textbody->{'data'} = $text; 152 } 153 } 154 } 155return ($sigcode, $sigmessage, $sindex); 156} 157 158# list_addresses() 159# Returns a list of address book entries, each an array reference containing 160# the email address, real name, index (if editable) and From: flag 161sub list_addresses 162{ 163my @rv; 164my $i = 0; 165open(my $ADDRESS, "<", $address_book); 166while(<$ADDRESS>) { 167 s/\r|\n//g; 168 my @sp = split(/\t/, $_); 169 if (@sp >= 1) { 170 push(@rv, [ $sp[0], $sp[1], $i, $sp[2] ]); 171 } 172 $i++; 173 } 174close($ADDRESS); 175if ($config{'global_address'}) { 176 my $gab = &group_subs($config{'global_address'}); 177 open(my $ADDRESS, "<", $gab); 178 while(<$ADDRESS>) { 179 s/\r|\n//g; 180 my @sp = split(/\t+/, $_); 181 if (@sp >= 2) { 182 push(@rv, [ $sp[0], $sp[1] ]); 183 } 184 } 185 close($ADDRESS); 186 } 187if ($userconfig{'sort_addrs'} == 2) { 188 return sort { lc($a->[0]) cmp lc($b->[0]) } @rv; 189 } 190elsif ($userconfig{'sort_addrs'} == 1) { 191 return sort { lc($a->[1]) cmp lc($b->[1]) } @rv; 192 } 193else { 194 return @rv; 195 } 196} 197 198# create_address(email, real name, forfrom) 199# Adds an entry to the address book 200sub create_address 201{ 202no strict "subs"; 203&open_tempfile(ADDRESS, ">>$address_book"); 204&print_tempfile(ADDRESS, "$_[0]\t$_[1]\t$_[2]\n"); 205&close_tempfile(ADDRESS); 206use strict "subs"; 207} 208 209# modify_address(index, email, real name, forfrom) 210# Updates some entry in the address book 211sub modify_address 212{ 213&replace_file_line($address_book, $_[0], "$_[1]\t$_[2]\t$_[3]\n"); 214} 215 216# delete_address(index) 217# Deletes some entry from the address book 218sub delete_address 219{ 220&replace_file_line($address_book, $_[0]); 221} 222 223# address_button(field, [form], [frommode], [realfield], [nogroups]) 224# Returns HTML for an address-book popup button 225sub address_button 226{ 227if (defined(&theme_address_button)) { 228 return &theme_address_button(@_); 229 } 230my $form = @_ > 1 ? $_[1] : 0; 231my $mode = @_ > 2 ? $_[2] : 0; 232my $nogroups = @_ > 4 ? $_[4] : 0; 233my ($rfield1, $rfield2); 234if ($_[3]) { 235 return "<input type=button onClick='ifield = document.forms[$form].$_[0]; rfield = document.forms[$form].$_[3]; chooser = window.open(\"../$module_name/address_chooser.cgi?addr=\"+escape(ifield.value)+\"&mode=$mode&nogroups=$nogroups\", \"chooser\", \"toolbar=no,menubar=no,scrollbars=yes,width=500,height=500\"); chooser.ifield = ifield; window.ifield = ifield; chooser.rfield = rfield; window.rfield = rfield' value=\"...\">\n"; 236 } 237else { 238 return "<input type=button onClick='ifield = document.forms[$form].$_[0]; chooser = window.open(\"../$module_name/address_chooser.cgi?addr=\"+escape(ifield.value)+\"&mode=$mode\", \"chooser\", \"toolbar=no,menubar=no,scrollbars=yes,width=500,height=500\"); chooser.ifield = ifield; window.ifield = ifield' value=\"...\">\n"; 239 } 240} 241 242# list_folders() 243# Returns a list of all folders for this user 244# folder types: 0 = mbox, 1 = maildir, 2 = pop3, 3 = mh, 4 = imap, 5 = combined, 245# 6 = virtual 246# folder modes: 0 = ~/mail, 1 = external folder, 2 = sent mail, 247# 3 = inbox/drafts/trash 248my @list_folders_cache; 249sub list_folders 250{ 251if (@list_folders_cache) { 252 return @list_folders_cache; 253 } 254my (@rv, $f, $o, %done); 255 256# Read the module's config directory, to find folders files 257opendir(DIR, $user_module_config_directory); 258my @folderfiles = readdir(DIR); 259closedir(DIR); 260 261if ($config{'mail_system'} == 2) { 262 # POP3 inbox 263 push(@rv, { 'name' => $text{'folder_inbox'}, 264 'type' => 2, 265 'server' => $config{'pop3_server'} || "localhost", 266 'mode' => 3, 267 'remote' => 1, 268 'nowrite' => 1, 269 'inbox' => 1, 270 'index' => 0 }); 271 &read_file("$user_module_config_directory/inbox.pop3", $rv[$#rv]); 272 } 273elsif ($config{'mail_system'} == 4) { 274 # IMAP inbox 275 my $imapserver = $config{'pop3_server'} || "localhost"; 276 push(@rv, { 'name' => $text{'folder_inbox'}, 277 'id' => 'INBOX', 278 'type' => 4, 279 'server' => $imapserver, 280 'ssl' => $config{'pop3_ssl'}, 281 'mode' => 3, 282 'remote' => 1, 283 'flags' => 1, 284 'inbox' => 1, 285 'index' => 0 }); 286 &read_file("$user_module_config_directory/inbox.imap", $rv[$#rv]); 287 288 # Use HTTP username and password, if available and if logging in to 289 # a local IMAP server. 290 if ($remote_user && $main::remote_pass && 291 (&to_ipaddress($rv[0]->{'server'}) eq '127.0.0.1' || 292 &to_ipaddress($rv[0]->{'server'}) eq 293 &to_ipaddress(&get_system_hostname()))) { 294 $rv[0]->{'user'} = $remote_user; 295 $rv[0]->{'pass'} = $main::remote_pass; 296 $rv[0]->{'autouser'} = 1; 297 } 298 299 # Get other IMAP folders (if we can) 300 my ($ok, $ih) = &imap_login($rv[0]); 301 if ($ok == 1) { 302 my @irv = &imap_command($ih, "list \"\" \"*\""); 303 if ($irv[0]) { 304 foreach my $l (@{$irv[1]}) { 305 if ($l =~ /LIST\s+\(.*\)\s+("(.*)"|\S+)\s+("(.*)"|\S+)/) { 306 # Found a folder line 307 my $fn = $4 || $3; 308 next if ($fn eq "INBOX"); 309 push(@rv, 310 { 'name' => &decode_utf7($fn), 311 'id' => $fn, 312 'type' => 4, 313 'server' => $imapserver, 314 'user' => $rv[0]->{'user'}, 315 'pass' => $rv[0]->{'pass'}, 316 'mode' => 0, 317 'remote' => 1, 318 'flags' => 1, 319 'imapauto' => 1, 320 'mailbox' => $fn, 321 'nologout' => $config{'nologout'}, 322 'index' => scalar(@rv) }); 323 &read_file("$user_module_config_directory/$fn.imap", $rv[$#rv]); 324 } 325 } 326 $rv[0]->{'nologout'} = $config{'nologout'}; 327 } 328 } 329 330 # Find or create the IMAP sent mail folder 331 my $sf; 332 my $sent; 333 if ($userconfig{'sent_name'}) { 334 ($sent) = grep { lc($_->{'name'}) eq lc($sf) } @rv; 335 } 336 else { 337 ($sent) = grep { lc($_->{'name'}) eq 'sent' } @rv; 338 if (!$sent) { 339 ($sent) = grep { $_->{'name'} =~ /sent/i } @rv; 340 } 341 } 342 if (!$sent && $ok == 1) { 343 my @irv = &imap_command($ih, "create \"$sf\""); 344 if ($irv[0]) { 345 $sent = { 'id' => $sf, 346 'type' => 4, 347 'server' => $imapserver, 348 'user' => $rv[0]->{'user'}, 349 'pass' => $rv[0]->{'pass'}, 350 'mode' => 2, 351 'remote' => 1, 352 'flags' => 1, 353 'imapauto' => 1, 354 'mailbox' => $sf, 355 'index' => scalar(@rv) }; 356 push(@rv, $sent); 357 &read_file("$user_module_config_directory/$sf.imap", 358 $sent); 359 } 360 } 361 if ($sent) { 362 $sent->{'name'} = $text{'folder_sent'}; 363 $sent->{'perpage'} = $userconfig{'perpage_sent_mail'}; 364 $sent->{'fromaddr'} = $userconfig{'fromaddr_sent_mail'}; 365 $sent->{'sent'} = 1; 366 $sent->{'mode'} = 2; 367 } 368 369 # Find or create the IMAP drafts folder 370 my $df = $userconfig{'drafts_name'} || 'drafts'; 371 my ($drafts) = grep { lc($_->{'name'}) eq lc($df) } @rv; 372 if (!$drafts && $ok == 1) { 373 my @irv = &imap_command($ih, "create \"$df\""); 374 if ($irv[0]) { 375 $drafts = { 'id' => $df, 376 'type' => 4, 377 'server' => $imapserver, 378 'user' => $rv[0]->{'user'}, 379 'pass' => $rv[0]->{'pass'}, 380 'mode' => 3, 381 'remote' => 1, 382 'flags' => 1, 383 'imapauto' => 1, 384 'mailbox' => $df, 385 'index' => scalar(@rv) }; 386 push(@rv, $drafts); 387 &read_file("$user_module_config_directory/$df.imap", 388 $drafts); 389 } 390 } 391 if ($drafts) { 392 $drafts->{'name'} = $text{'folder_drafts'}; 393 $drafts->{'drafts'} = 1; 394 $drafts->{'mode'} = 3; 395 } 396 397 # Find or create the IMAP trash folder 398 if ($userconfig{'delete_mode'} == 1) { 399 my $tf = $userconfig{'trash_name'} || 'trash'; 400 my ($trash) = grep { lc($_->{'name'}) eq lc($tf) } @rv; 401 if (!$trash && $ok == 1) { 402 my @irv = &imap_command($ih, "create \"$tf\""); 403 if ($irv[0]) { 404 $trash = { 'id' => $tf, 405 'type' => 4, 406 'server' => $imapserver, 407 'user' => $rv[0]->{'user'}, 408 'pass' => $rv[0]->{'pass'}, 409 'mode' => 3, 410 'remote' => 1, 411 'flags' => 1, 412 'imapauto' => 1, 413 'mailbox' => $tf, 414 'index' => scalar(@rv) }; 415 push(@rv, $trash); 416 &read_file( 417 "$user_module_config_directory/$tf.imap", 418 $trash); 419 } 420 } 421 if ($trash) { 422 $trash->{'name'} = $text{'folder_trash'}; 423 $trash->{'trash'} = 1; 424 $trash->{'mode'} = 3; 425 } 426 } 427 428 # For each IMAP folder, guess the underlying file 429 foreach my $f (@rv) { 430 if ($f->{'inbox'}) { 431 # Use the configured inbox location 432 my $path = $config{'mail_system'} == 0 ? 433 &user_mail_file(@remote_user_info) : 434 $qmail_maildir; 435 $f->{'file'} = $path if (-e $path); 436 } 437 else { 438 # Look in configured folders directory 439 my $path = "$folders_dir/$f->{'id'}"; 440 if (-e $path) { 441 $f->{'file'} = $path; 442 } 443 else { 444 # Try . at start of folder names 445 my $n = $f->{'id'}; 446 $n =~ s/^\.//; 447 if ($n =~ /\//) { 448 # Turn foo/bar to foo/.bar 449 $n =~ s/\//\/\./; 450 } 451 else { 452 # Turn foo to .foo 453 $n = ".".$n; 454 } 455 $path = "$folders_dir/$n"; 456 $f->{'file'} = $path if (-e $path); 457 } 458 } 459 } 460 461 goto IMAPONLY; 462 } 463else { 464 # Local mail file inbox 465 push(@rv, { 'name' => $text{'folder_inbox'}, 466 'type' => $config{'mail_system'}, 467 'mode' => 3, 468 'inbox' => 1, 469 'file' => $config{'mail_system'} == 0 ? 470 &user_mail_file(@remote_user_info) : 471 $qmail_maildir, 472 'index' => 0 }); 473 $done{$rv[$#rv]->{'file'}}++; 474 } 475my $inbox = $rv[$#rv]; 476 477# Add sent mail file 478my $sf; 479if ($folder_types{'ext'} && $userconfig{'sent_mail'}) { 480 $sf = $userconfig{'sent_mail'}; 481 $done{$userconfig{'sent_mail'}}++; 482 } 483else { 484 my $sfn = $userconfig{'sent_name'} || 'sentmail'; 485 $sf = "$folders_dir/$sfn"; 486 if (!-e $sf && $userconfig{'mailbox_dir'} eq "Maildir") { 487 # For Maildir++ , use .sentmail 488 $sf = "$folders_dir/.$sfn"; 489 } 490 } 491$done{$sf}++; 492my $sft = -e $sf ? &folder_type($sf) : 493 $userconfig{'mailbox_dir'} eq "Maildir" ? 1 : 0; 494push(@rv, { 'name' => $text{'folder_sent'}, 495 'type' => $sft, 496 'file' => $sf, 497 'perpage' => $userconfig{'perpage_sent_mail'}, 498 'fromaddr' => $userconfig{'fromaddr_sent_mail'}, 499 'hide' => $userconfig{'hide_sent_mail'}, 500 'mode' => 2, 501 'sent' => 1, 502 'index' => scalar(@rv) }); 503 504# Add drafts file 505my $dn = $userconfig{'drafts_name'}; 506if ($dn && $userconfig{'mailbox_dir'} eq "Maildir" && $dn !~ /^\./) { 507 # Maildir++ folders always start with . 508 $dn = ".".$dn; 509 } 510my $df = $dn ? "$folders_dir/$dn" : 511 -r "$folders_dir/Drafts" ? "$folders_dir/Drafts" : 512 -r "$folders_dir/.Drafts" ? "$folders_dir/.Drafts" : 513 -r "$folders_dir/.drafts" ? "$folders_dir/.drafts" : 514 $userconfig{'mailbox_dir'} eq "Maildir" ? "$folders_dir/.drafts" : 515 "$folders_dir/drafts"; 516$done{$df}++; 517my $dft = -e $df ? &folder_type($df) : 518 $userconfig{'mailbox_dir'} eq "Maildir" ? 1 : 0; 519push(@rv, { 'name' => $text{'folder_drafts'}, 520 'type' => $dft, 521 'file' => $df, 522 'mode' => 3, 523 'drafts' => 1, 524 'index' => scalar(@rv) }); 525 526# Add trash folder 527my $tn = $userconfig{'trash_name'}; 528if ($tn && $userconfig{'mailbox_dir'} eq "Maildir" && $tn !~ /^\./) { 529 # Maildir++ folders always start with . 530 $tn = ".".$tn; 531 } 532my $tf = $tn ? "$folders_dir/$tn" : 533 -r "$folders_dir/Trash" ? "$folders_dir/Trash" : 534 -r "$folders_dir/.Trash" ? "$folders_dir/.Trash" : 535 -r "$folders_dir/.trash" ? "$folders_dir/.trash" : 536 $userconfig{'mailbox_dir'} eq "Maildir" ? 537 "$folders_dir/.trash" : "$folders_dir/trash"; 538$done{$tf}++; 539my $tft = -e $tf ? &folder_type($tf) : 540 $userconfig{'mailbox_dir'} eq "Maildir" ? 1 : 0; 541push(@rv, { 'name' => $text{'folder_trash'}, 542 'type' => $tft, 543 'file' => $tf, 544 'mode' => 3, 545 'trash' => 1, 546 'index' => scalar(@rv) }); 547 548# Add local folders, usually under ~/mail 549if ($folder_types{'local'}) { 550 foreach my $p (&recursive_files($folders_dir, 551 $userconfig{'mailbox_recur'})) { 552 my $f = $p; 553 $f =~ s/^\Q$folders_dir\E\///; 554 my $name = $f; 555 if ($folders_dir eq "$remote_user_info[7]/Maildir") { 556 # A sub-folder under Maildir .. remove the . at the 557 # start of the sub-folder name 558 $name =~ s/^\.// || $name =~ s/\/\./\// || next; 559 560 # When in Maildir++ mode, any non-subdirectory 561 # is ignored 562 next if (!-d $p); 563 } 564 push(@rv, { 'name' => decode_utf7($name), 565 'file' => $p, 566 'type' => &folder_type($p), 567 'perpage' => $userconfig{"perpage_$f"}, 568 'fromaddr' => $userconfig{"fromaddr_$f"}, 569 'show_to' => $userconfig{"show_to_$f"}, 570 'sent' => $userconfig{"sent_$f"}, 571 'hide' => $userconfig{"hide_$f"}, 572 'mode' => 0, 573 'index' => scalar(@rv) } ) if (!$done{$p}); 574 $done{$p}++; 575 } 576 } 577 578# Add sub-folders in ~/Maildir/ , as used by Courier 579if ($inbox->{'type'} == 1 && $userconfig{'mailbox_dir'} ne "Maildir") { 580 foreach my $p (&recursive_files($inbox->{'file'}, 0)) { 581 my $f = $p; 582 $f =~ s/^\Q$inbox->{'file'}\E\///; 583 my $name = $f; 584 $name =~ s/^\.// || $name =~ s/\/\./\//; 585 push(@rv, { 'name' => $name, 586 'file' => $p, 587 'type' => &folder_type($p), 588 'perpage' => $userconfig{"perpage_$f"}, 589 'fromaddr' => $userconfig{"fromaddr_$f"}, 590 'show_to' => $userconfig{"show_to_$f"}, 591 'sent' => $userconfig{"sent_$f"}, 592 'hide' => $userconfig{"hide_$f"}, 593 'mode' => 0, 594 'index' => scalar(@rv) } ) if (!$done{$p}); 595 $done{$p}++; 596 } 597 } 598 599# Add user-defined external mail file folders 600if ($folder_types{'ext'}) { 601 foreach my $o (split(/\t+/, $userconfig{'mailboxes'})) { 602 $o =~ /\/([^\/]+)$/ || next; 603 push(@rv, { 'name' => $userconfig{"folder_$o"} || $1, 604 'file' => $o, 605 'perpage' => $userconfig{"perpage_$o"}, 606 'fromaddr' => $userconfig{"fromaddr_$o"}, 607 'show_to' => $userconfig{"show_to_$o"}, 608 'sent' => $userconfig{"sent_$o"}, 609 'hide' => $userconfig{"hide_$o"}, 610 'type' => &folder_type($o), 611 'mode' => 1, 612 'index' => scalar(@rv) } ) if (!$done{$o}); 613 $done{$o}++; 614 } 615 } 616 617# Add user-defined POP3 and IMAP folders 618foreach my $f (@folderfiles) { 619 if ($f =~ /^(\d+)\.pop3$/ && $folder_types{'pop3'}) { 620 my %pop3 = ( 'id' => $1 ); 621 &read_file("$user_module_config_directory/$f", \%pop3); 622 $pop3{'type'} = 2; 623 $pop3{'mode'} = 0; 624 $pop3{'remote'} = 1; 625 $pop3{'nowrite'} = 1; 626 $pop3{'index'} = scalar(@rv); 627 push(@rv, \%pop3); 628 } 629 elsif ($f =~ /^(\d+)\.imap$/ && $folder_types{'imap'}) { 630 my %imap = ( 'id' => $1 ); 631 &read_file("$user_module_config_directory/$f", \%imap); 632 $imap{'type'} = 4; 633 $imap{'mode'} = 0; 634 $imap{'remote'} = 1; 635 $imap{'flags'} = 1; 636 $imap{'index'} = scalar(@rv); 637 push(@rv, \%imap); 638 } 639 } 640 641# When in IMAP inbox mode, we goto this label to skip all my folders 642IMAPONLY: 643 644# Add user-defined composite folders 645my %fcache; 646foreach my $f (@folderfiles) { 647 if ($f =~ /^(\d+)\.comp$/) { 648 my %comp = ( 'id' => $1 ); 649 &read_file("$user_module_config_directory/$f", \%comp); 650 $comp{'folderfile'} = "$user_module_config_directory/$f"; 651 $comp{'type'} = 5; 652 $comp{'mode'} = 0; 653 $comp{'index'} = scalar(@rv); 654 my $sfn; 655 foreach my $sfn (split(/\t+/, $comp{'subfoldernames'})) { 656 my $sf = &find_named_folder($sfn, \@rv, \%fcache); 657 push(@{$comp{'subfolders'}}, $sf) if ($sf); 658 } 659 push(@rv, \%comp); 660 } 661 } 662 663# Add spam folder as specified in spamassassin module, in case it is 664# outside of the folders we scan 665if (&foreign_check("spam")) { 666 my %suserconfig = &foreign_config("spam", 1); 667 my $file = $suserconfig{'spam_file'}; 668 $file ||= ""; 669 $file =~ s/\.$//; 670 $file =~ s/\/$//; 671 $file = "$remote_user_info[7]/$file" if ($file && $file !~ /^\//); 672 $file =~ s/\~/$remote_user_info[7]/; 673 if ($file) { 674 if ($config{'mail_system'} == 4) { 675 # In IMAP mode, the first folder named spam is marked 676 my ($sf) = grep { lc($_->{'name'}) eq 'spam' } @rv; 677 if ($sf) { 678 $sf->{'spam'} = 1; 679 } 680 } 681 elsif (!$done{$file}) { 682 # Need to add 683 push(@rv, { 'name' => "Spam", 684 'file' => $file, 685 'type' => &folder_type($file), 686 'perpage' => $userconfig{"perpage_$file"}, 687 'fromaddr' => $userconfig{"fromaddr_$file"}, 688 'sent' => $userconfig{"sent_$file"}, 689 'hide' => 0, 690 'mode' => 0, 691 'spam' => 1, 692 'index' => scalar(@rv) } ); 693 $done{$file}++; 694 } 695 else { 696 # Mark as spam folder 697 my ($sf) = grep { $_->{'file'} eq $file } @rv; 698 if ($sf) { 699 $sf->{'spam'} = 1; 700 } 701 } 702 } 703 } 704 705# Add virtual folders. This has to be last, so that other folders can be found 706# based on virtual/composite indexes. 707foreach my $f (@folderfiles) { 708 if ($f =~ /^(\d+)\.virt$/) { 709 my %virt = ( 'id' => $1 ); 710 &read_file("$user_module_config_directory/$f", \%virt); 711 $virt{'folderfile'} = "$user_module_config_directory/$f"; 712 $virt{'type'} = 6; 713 $virt{'mode'} = 0; 714 $virt{'index'} = scalar(@rv); 715 $virt{'noadd'} = 1; 716 $virt{'members'} = [ ]; 717 push(@rv, \%virt); 718 } 719 } 720 721# Expand virtual folder sub-folders 722foreach my $virt (grep { $_->{'type'} == 6 } @rv) { 723 foreach my $k (keys %$virt) { 724 next if ($k !~ /^\d+$/); 725 next if ($virt->{$k} !~ /\t/); # Old format 726 my ($sfn, $id) = split(/\t+/, $virt->{$k}, 2); 727 my $sf = &find_named_folder($sfn, \@rv, \%fcache); 728 $virt->{'members'}->[$k] = [ $sf, $id ] if ($sf); 729 delete($virt->{$k}); 730 } 731 } 732 733# Work out last-modified time of all folders, and set sortable flag 734&set_folder_lastmodified(\@rv); 735 736# Set searchable flag 737foreach my $f (@rv) { 738 $f->{'searchable'} = 1 if ($f->{'type'} != 6 || 739 $f->{'id'} != $search_folder_id); 740 } 741 742# Set show to/from flags 743foreach my $f (@rv) { 744 if (!defined($f->{'show_to'})) { 745 $f->{'show_to'} = $f->{'sent'} || $f->{'drafts'} || 746 $userconfig{'show_to'}; 747 } 748 if (!defined($f->{'show_from'})) { 749 $f->{'show_from'} = !($f->{'sent'} || $f->{'drafts'}) || 750 $userconfig{'show_to'}; 751 } 752 } 753 754# For Maildir folders, check if we can get the read flag from the folder files 755foreach my $f (@rv) { 756 if ($f->{'type'} == 1) { 757 $f->{'flags'} = 2; 758 } 759 } 760 761@list_folders_cache = @rv; 762return @rv; 763} 764 765# get_spam_inbox_folder() 766# Returns the folder to which spam should be moved 767sub get_spam_inbox_folder 768{ 769my ($inbox) = grep { $_->{'inbox'} } &list_folders(); 770return $inbox; 771} 772 773# save_folder(&folder, [&old]) 774# Creates or updates a folder 775sub save_folder 776{ 777my ($folder, $old) = @_; 778mkdir($folders_dir, 0700) if (!-d $folders_dir); 779if ($folder->{'type'} == 2) { 780 # A POP3 folder 781 $folder->{'id'} ||= time(); 782 my %pop3; 783 foreach my $k (keys %$folder) { 784 if ($k ne "type" && $k ne "mode" && $k ne "remote" && 785 $k ne "nowrite" && $k ne "index") { 786 $pop3{$k} = $folder->{$k}; 787 } 788 } 789 &write_file("$user_module_config_directory/$folder->{'id'}.pop3", 790 \%pop3); 791 chmod(0700, "$user_module_config_directory/$folder->{'id'}.pop3"); 792 } 793elsif ($folder->{'type'} == 4) { 794 # An IMAP folder 795 my @exclude; 796 if ($folder->{'imapauto'}) { 797 # This type of folder needs to be really created or updated 798 # on the server 799 if (!$folder->{'id'}) { 800 # Need to create 801 my ($ok, $ih) = &imap_login($folder); 802 my @irv = &imap_command($ih, 803 "create \"$folder->{'name'}\""); 804 $irv[0] || &error($irv[2]); 805 $folder->{'id'} = $folder->{'mailbox'} = 806 $folder->{'name'}; 807 } 808 elsif ($folder->{'mailbox'} ne $folder->{'name'}) { 809 # Need to rename 810 my ($ok, $ih) = &imap_login($folder); 811 my @irv = &imap_command($ih, 812 "rename \"$folder->{'mailbox'}\" \"$folder->{'name'}\""); 813 $irv[0] || &error($irv[2]); 814 $folder->{'id'} = $folder->{'name'}; 815 $folder->{'id'} = $folder->{'mailbox'} = 816 $folder->{'name'}; 817 } 818 @exclude = ( "type", "mode", "remote", "nowrite", "index", 819 "id", "mailbox", "server", "user", "pass" ); 820 } 821 else { 822 # Just save details of IMAP folder in a file 823 $folder->{'id'} ||= time(); 824 @exclude = ( "type", "mode", "remote", "nowrite", "index" ); 825 } 826 my %imap; 827 foreach my $k (keys %$folder) { 828 if (&indexof($k, @exclude) == -1) { 829 $imap{$k} = $folder->{$k}; 830 } 831 } 832 &write_file("$user_module_config_directory/$folder->{'id'}.imap", 833 \%imap); 834 chmod(0700, "$user_module_config_directory/$folder->{'id'}.imap"); 835 } 836elsif ($folder->{'type'} == 5) { 837 # A composite 838 $folder->{'id'} ||= time(); 839 my %comp; 840 foreach my $k (keys %$folder) { 841 if ($k ne "type" && $k ne "mode" && $k ne "index" && 842 $k ne "subfolders") { 843 $comp{$k} = $folder->{$k}; 844 } 845 } 846 my ($sf, @sfns); 847 foreach my $sf (@{$folder->{'subfolders'}}) { 848 my $sfn = &folder_name($sf); 849 push(@sfns, $sfn); 850 } 851 $comp{'subfoldernames'} = join("\t", @sfns); 852 &write_file("$user_module_config_directory/$folder->{'id'}.comp", 853 \%comp); 854 chmod(0700, "$user_module_config_directory/$folder->{'id'}.comp"); 855 } 856elsif ($folder->{'type'} == 6) { 857 # A virtual folder 858 $folder->{'id'} ||= time(); 859 my %virt; 860 foreach my $k (keys %$folder) { 861 if ($k ne "type" && $k ne "mode" && $k ne "index" && 862 $k ne "members") { 863 $virt{$k} = $folder->{$k}; 864 } 865 } 866 my $i; 867 my $mems = $folder->{'members'}; 868 for($i=0; $i<@$mems; $i++) { 869 $virt{$i} = &folder_name($mems->[$i]->[0])."\t". 870 $mems->[$i]->[1]; 871 } 872 &write_file("$user_module_config_directory/$folder->{'id'}.virt", 873 \%virt); 874 chmod(0700, "$user_module_config_directory/$folder->{'id'}.virt"); 875 } 876elsif ($folder->{'mode'} == 0) { 877 # Updating a folder in ~/mail .. need to manage file, and config options 878 my $path = "$folders_dir/$folder->{'name'}"; 879 if ($folders_dir eq "$remote_user_info[7]/Maildir") { 880 # Maildir sub-folder .. put a . in the name 881 $path =~ s/([^\/]+)$/.$1/; 882 } 883 if ($folder->{'name'} =~ /\//) { 884 my $pp = $path; 885 $pp =~ s/\/[^\/]+$//; 886 system("mkdir -p ".quotemeta($pp)); 887 } 888 if (!$old) { 889 # Create the mailbox/maildir/MH dir 890 if ($folder->{'type'} == 0) { 891 open(my $FOLDER, ">>", "$path"); 892 close($FOLDER); 893 chmod(0700, $path); 894 } 895 elsif ($folder->{'type'} == 1) { 896 mkdir($path, 0700); 897 mkdir("$path/cur", 0700); 898 mkdir("$path/new", 0700); 899 mkdir("$path/tmp", 0700); 900 } 901 elsif ($folder->{'type'} == 3) { 902 mkdir($path, 0700); 903 } 904 } 905 elsif ($old->{'name'} ne $folder->{'name'}) { 906 # Just rename 907 rename($old->{'file'}, $path); 908 } 909 if ($old) { 910 delete($userconfig{'perpage_'.$old->{'name'}}); 911 delete($userconfig{'sent_'.$old->{'name'}}); 912 delete($userconfig{'hide_'.$old->{'name'}}); 913 delete($userconfig{'fromaddr_'.$old->{'name'}}); 914 } 915 $userconfig{'perpage_'.$folder->{'name'}} = $folder->{'perpage'} 916 if ($folder->{'perpage'}); 917 $userconfig{'sent_'.$folder->{'name'}} = $folder->{'sent'} 918 if ($folder->{'sent'}); 919 $userconfig{'hide_'.$folder->{'name'}} = $folder->{'hide'} 920 if ($folder->{'hide'}); 921 $userconfig{'fromaddr_'.$folder->{'name'}} = $folder->{'fromaddr'} 922 if ($folder->{'fromaddr'}); 923 $userconfig{'show_to_'.$folder->{'name'}} = $folder->{'show_to'}; 924 &save_user_module_config(); 925 $folder->{'file'} = $path; 926 } 927elsif ($folder->{'mode'} == 1) { 928 # Updating or adding an external file folder 929 my @mailboxes = split(/\t+/, $userconfig{'mailboxes'}); 930 if (!$old) { 931 push(@mailboxes, $folder->{'file'}); 932 } 933 else { 934 delete($userconfig{'folder_'.$folder->{'file'}}); 935 delete($userconfig{'perpage_'.$folder->{'file'}}); 936 delete($userconfig{'sent_'.$folder->{'file'}}); 937 delete($userconfig{'hide_'.$folder->{'file'}}); 938 delete($userconfig{'fromaddr_'.$folder->{'file'}}); 939 my $idx = &indexof($folder->{'file'}, @mailboxes); 940 $mailboxes[$idx] = $folder->{'file'}; 941 } 942 $userconfig{'folder_'.$folder->{'file'}} = $folder->{'name'}; 943 $userconfig{'perpage_'.$folder->{'file'}} = $folder->{'perpage'} 944 if ($folder->{'perpage'}); 945 $userconfig{'sent_'.$folder->{'file'}} = $folder->{'sent'}; 946 $userconfig{'hide_'.$folder->{'file'}} = $folder->{'hide'} 947 if ($folder->{'hide'}); 948 $userconfig{'fromaddr_'.$folder->{'file'}} = $folder->{'fromaddr'} 949 if ($folder->{'fromaddr'}); 950 $userconfig{'show_to_'.$folder->{'file'}} = $folder->{'show_to'}; 951 $userconfig{'mailboxes'} = join("\t", @mailboxes); 952 &save_user_module_config(); 953 } 954elsif ($folder->{'mode'} == 2) { 955 # The sent mail folder 956 delete($userconfig{'perpage_sent_mail'}); 957 delete($userconfig{'hide_sent_mail'}); 958 delete($userconfig{'fromaddr_sent_mail'}); 959 my $sf = "$folders_dir/sentmail"; 960 if ($folder->{'file'} eq $sf) { 961 delete($userconfig{'sent_mail'}); 962 } 963 else { 964 $userconfig{'sent_mail'} = $folder->{'file'}; 965 } 966 $userconfig{'perpage_sent_mail'} = $folder->{'perpage'} 967 if ($folder->{'perpage'}); 968 $userconfig{'hide_sent_mail'} = $folder->{'hide'} 969 if ($folder->{'hide'}); 970 $userconfig{'fromaddr_sent_mail'} = $folder->{'fromaddr'} 971 if ($folder->{'fromaddr'}); 972 &save_user_module_config(); 973 } 974# Add to or update cache 975if (@list_folders_cache) { 976 if ($old) { 977 my $idx = &indexof($old, @list_folders_cache); 978 if ($idx >= 0) { 979 $list_folders_cache[$idx] = $folder; 980 } 981 } 982 else { 983 push(@list_folders_cache, $folder); 984 } 985 } 986} 987 988# delete_folder(&folder) 989# Removes some folder 990sub delete_folder 991{ 992my ($folder) = @_; 993if ($folder->{'type'} == 2) { 994 # A POP3 folder 995 unlink("$user_module_config_directory/$folder->{'id'}.pop3"); 996 system("rm -rf $user_module_config_directory/$folder->{'id'}.cache"); 997 } 998elsif ($folder->{'type'} == 4) { 999 # An IMAP folder 1000 unlink("$user_module_config_directory/$folder->{'id'}.imap"); 1001 system("rm -rf $user_module_config_directory/$folder->{'id'}.cache"); 1002 1003 if ($folder->{'imapauto'}) { 1004 # Remove actual folder from IMAP server too 1005 my ($ok, $ih) = &imap_login($folder); 1006 my @irv = &imap_command($ih, "delete \"$folder->{'name'}\""); 1007 $irv[0] || &error($irv[2] || "Unknown IMAP error"); 1008 } 1009 } 1010elsif ($folder->{'type'} == 5) { 1011 # A composite folder 1012 unlink("$user_module_config_directory/$folder->{'id'}.comp"); 1013 } 1014elsif ($folder->{'type'} == 6) { 1015 # A virtual folder 1016 unlink("$user_module_config_directory/$folder->{'id'}.virt"); 1017 } 1018elsif ($folder->{'mode'} == 0) { 1019 # Deleting a folder within ~/mail 1020 if ($folder->{'type'} == 0) { 1021 unlink($folder->{'file'}); 1022 } 1023 else { 1024 system("rm -rf ".quotemeta($folder->{'file'})); 1025 } 1026 delete($userconfig{'perpage_'.$folder->{'name'}}); 1027 delete($userconfig{'sent_'.$folder->{'name'}}); 1028 delete($userconfig{'hide_'.$folder->{'name'}}); 1029 delete($userconfig{'fromaddr_'.$folder->{'name'}}); 1030 &save_user_module_config(); 1031 } 1032elsif ($folder->{'mode'} == 1) { 1033 # Remove from list of external folders 1034 my @mailboxes = split(/\t+/, $userconfig{'mailboxes'}); 1035 @mailboxes = grep { $_ ne $folder->{'file'} } @mailboxes; 1036 delete($userconfig{'folder_'.$folder->{'file'}}); 1037 delete($userconfig{'perpage_'.$folder->{'file'}}); 1038 delete($userconfig{'sent_'.$folder->{'file'}}); 1039 delete($userconfig{'hide_'.$folder->{'file'}}); 1040 delete($userconfig{'fromaddr_'.$folder->{'file'}}); 1041 $userconfig{'mailboxes'} = join("\t", @mailboxes); 1042 &save_user_module_config(); 1043 } 1044 1045# Remove from cache 1046if (@list_folders_cache) { 1047 @list_folders_cache = grep { $_ ne $folder } @list_folders_cache; 1048 } 1049 1050# Delete mbox or Maildir index 1051if ($folder->{'type'} == 0) { 1052 my $ifile = &user_index_file($folder->{'file'}); 1053 unlink(glob("$ifile.*"), $ifile); 1054 } 1055elsif ($folder->{'type'} == 1) { 1056 my $cachefile = &get_maildir_cachefile($folder->{'file'}); 1057 unlink($cachefile); 1058 } 1059 1060# Delete sort index 1061my $ifile = &folder_new_sort_index_file($folder); 1062unlink(glob("$ifile.*"), $ifile); 1063 1064# Delete sort direction file 1065my $file = &folder_name($folder); 1066$file =~ s/\//_/g; 1067unlink("$user_module_config_directory/sort.$file"); 1068} 1069 1070# need_delete_warn(&folder) 1071sub need_delete_warn 1072{ 1073return 0 if ($_[0]->{'type'} == 6 && !$_[0]->{'delete'}); 1074return 1 if ($userconfig{'delete_warn'} eq 'y'); 1075return 0 if ($userconfig{'delete_warn'} eq 'n'); 1076my $mf; 1077return $_[0]->{'type'} == 0 && 1078 ($mf = &folder_file($_[0])) && 1079 &disk_usage_kb($mf)*1024 > $userconfig{'delete_warn'}; 1080} 1081 1082# get_signature() 1083# Returns the users signature, if any 1084sub get_signature 1085{ 1086my $sf = &get_signature_file(); 1087$sf || return undef; 1088return &read_file_contents($sf); 1089} 1090 1091# get_signature_file() 1092# Returns the full path to the file that should contain the user's signature, 1093# or undef if none is defined 1094sub get_signature_file 1095{ 1096return undef if ($userconfig{'sig_file'} eq '*'); 1097my $sf = $userconfig{'sig_file'}; 1098$sf = "$remote_user_info[7]/$sf" if ($sf !~ /^\//); 1099return &group_subs($sf); 1100} 1101 1102# movecopy_select(number, &folders, &folder-to-exclude, copy-only) 1103# Returns HTML for selecting a folder to move or copy to 1104sub movecopy_select 1105{ 1106my $rv; 1107if (!$_[3]) { 1108 $rv .= &ui_submit($text{'mail_move'}, "move".$_[0]); 1109 } 1110print &ui_submit($text{'mail_copy'}, "copy".$_[0]); 1111my @mfolders = grep { $_ ne $_[2] && !$_->{'nowrite'} } @{$_[1]}; 1112$rv .= &folder_select(\@mfolders, undef, "mfolder$_[0]"); 1113return $rv; 1114} 1115 1116# show_folder_options(&folder, mode) 1117# Print HTML for editing the options for some folder 1118sub show_folder_options 1119{ 1120my ($folder, $mode) = @_; 1121 1122# Messages per page 1123print &ui_table_row($text{'edit_perpage'}, 1124 &ui_opt_textbox("perpage", $folder->{'perpage'}, 5, $text{'default'})); 1125 1126# Show as sent mail 1127if ($mode != 2) { 1128 print &ui_table_row($text{'edit_sentview'}, 1129 &ui_yesno_radio("show_to", $folder->{'show_to'})); 1130 } 1131 1132# From address for sent mail 1133print &ui_table_row($text{'edit_fromaddr'}, 1134 &ui_opt_textbox("fromaddr", $folder->{'fromaddr'}, 30, 1135 $text{'default'})." ". 1136 &address_button("fromaddr", 0, 1)); 1137 1138# Hide from folder list? 1139print &ui_table_row($text{'edit_hide'}, 1140 &ui_yesno_radio("hide", $folder->{'hide'})); 1141} 1142 1143# parse_folder_options(&folder, mode, &in) 1144sub parse_folder_options 1145{ 1146my ($folder, $mode, $in) = @_; 1147if (!$in->{'perpage_def'}) { 1148 $in->{'perpage'} =~ /^\d+$/ || &error($text{'save_eperpage'}); 1149 $folder->{'perpage'} = $in->{'perpage'}; 1150 } 1151else { 1152 delete($folder->{'perpage'}); 1153 } 1154if ($mode != 2) { 1155 $folder->{'show_to'} = $in->{'show_to'}; 1156 $folder->{'show_from'} = !$in->{'show_to'}; 1157 } 1158if (!$in->{'fromaddr_def'}) { 1159 $in->{'fromaddr'} =~ /\S/ || &error($text{'save_efromaddr'}); 1160 $folder->{'fromaddr'} = $in->{'fromaddr'}; 1161 } 1162$folder->{'hide'} = $in->{'hide'}; 1163} 1164 1165# list_address_groups() 1166# Returns a list of address book entries, each an array reference containing 1167# the group name, members and index 1168sub list_address_groups 1169{ 1170my @rv; 1171my $i = 0; 1172if (open(my $ADDRESS, "<", $address_group_book)) { 1173 while(<$ADDRESS>) { 1174 s/\r|\n//g; 1175 my @sp = split(/\t+/, $_); 1176 if (@sp == 2) { 1177 push(@rv, [ $sp[0], $sp[1], $i ]); 1178 } 1179 $i++; 1180 } 1181 close($ADDRESS); 1182 } 1183if ($config{'global_address_group'}) { 1184 my $gab = &group_subs($config{'global_address_group'}); 1185 if (open(my $ADDRESS, "<", $gab)) { 1186 while(<$ADDRESS>) { 1187 s/\r|\n//g; 1188 my @sp = split(/\t+/, $_); 1189 if (@sp == 2) { 1190 push(@rv, [ $sp[0], $sp[1] ]); 1191 } 1192 } 1193 close($ADDRESS); 1194 } 1195 } 1196if ($userconfig{'sort_addrs'} == 1) { 1197 return sort { lc($a->[0]) cmp lc($b->[0]) } @rv; 1198 } 1199elsif ($userconfig{'sort_addrs'} == 2) { 1200 return sort { lc($a->[1]) cmp lc($b->[1]) } @rv; 1201 } 1202else { 1203 return @rv; 1204 } 1205} 1206 1207# create_address_group(name, members) 1208# Adds an entry to the address group book 1209sub create_address_group 1210{ 1211no strict "subs"; 1212&open_tempfile(ADDRESS, ">>$address_group_book"); 1213&print_tempfile(ADDRESS, "$_[0]\t$_[1]\n"); 1214&close_tempfile(ADDRESS); 1215use strict "subs"; 1216} 1217 1218# modify_address_group(index, name, members) 1219# Updates some entry in the address group book 1220sub modify_address_group 1221{ 1222&replace_file_line($address_group_book, $_[0], "$_[1]\t$_[2]\n"); 1223} 1224 1225# delete_address_group(index) 1226# Deletes some entry from the address group book 1227sub delete_address_group 1228{ 1229&replace_file_line($address_group_book, $_[0]); 1230} 1231 1232# list_folders_sorted() 1233# Like list_folders(), but applies the chosen sort 1234sub list_folders_sorted 1235{ 1236my @folders = &list_folders(); 1237my @rv; 1238if ($userconfig{'folder_sort'} == 0) { 1239 # Builtin, then ~/mail, then external 1240 my @builtin = grep { $_->{'mode'} >= 2 } @folders; 1241 my @local = grep { $_->{'mode'} == 0 } @folders; 1242 my @external = grep { $_->{'mode'} == 1 } @folders; 1243 @rv = (@builtin, 1244 (sort { lc($a->{'name'}) cmp lc($b->{'name'}) } @local), 1245 (sort { lc($a->{'name'}) cmp lc($b->{'name'}) } @external)); 1246 } 1247elsif ($userconfig{'folder_sort'} == 1) { 1248 # Builtin, then rest sorted by name 1249 my @builtin = grep { $_->{'mode'} >= 2 } @folders; 1250 my @extra = grep { $_->{'mode'} < 2 } @folders; 1251 @rv = (@builtin, 1252 sort { lc($a->{'name'}) cmp lc($b->{'name'}) } @extra); 1253 } 1254elsif ($userconfig{'folder_sort'} == 2) { 1255 # All by name 1256 @rv = sort { lc($a->{'name'}) cmp lc($b->{'name'}) } @folders; 1257 } 1258if ($userconfig{'default_folder'} && $userconfig{'folder_sort'} <= 1) { 1259 # Move default folder to top of the list 1260 my $df = &find_named_folder($userconfig{'default_folder'}, \@rv); 1261 if ($df) { 1262 @rv = ( $df, grep { $_ ne $df } @rv ); 1263 } 1264 } 1265return @rv; 1266} 1267 1268# group_subs(filename) 1269# Replaces $group in a filename with the first valid primary or secondary 1270# that matches a file 1271sub group_subs 1272{ 1273my @ginfo = getgrgid($remote_user_info[3]); 1274my $rv = $_[0]; 1275$rv =~ s/\$group/$ginfo[0]/g; 1276if ($rv =~ /\$sgroup/) { 1277 # Try all secondary groups, and stop at the first one 1278 setgrent(); 1279 while(@ginfo = getgrent()) { 1280 my @m = split(/\s+/, $ginfo[3]); 1281 if (&indexof($remote_user, @m) >= 0) { 1282 my $rv2 = $rv; 1283 $rv2 =~ s/\$sgroup/$ginfo[0]/g; 1284 if (-r $rv2) { 1285 $rv = $rv2; 1286 last; 1287 } 1288 } 1289 } 1290 endgrent() if ($gconfig{'os_type'} ne 'hpux'); 1291 } 1292return $rv; 1293} 1294 1295# set_module_index(folder-num) 1296sub set_module_index 1297{ 1298$module_index_link = "/$module_name/index.cgi?folder=$_[0]&start=$in{'start'}"; 1299$module_index_name = $text{'mail_indexlink'}; 1300} 1301 1302# check_modification(&folder) 1303# Display an error message if a folder has been modified since the time 1304# in $in{'mod'} 1305sub check_modification 1306{ 1307my $newmod = &modification_time($_[0]); 1308if ($in{'mod'} && $in{'mod'} != $newmod && $userconfig{'check_mod'}) { 1309 # Changed! 1310 &error(&text('emodified', "index.cgi?folder=$_[0]->{'index'}")); 1311 } 1312} 1313 1314# list_from_addresses() 1315# Returns a list of allowed From: addresses for the current user 1316sub list_from_addresses 1317{ 1318my $http_host = $ENV{'HTTP_HOST'}; 1319$http_host =~ s/:\d+$//; 1320if (&check_ipaddress($http_host)) { 1321 # Try to reverse-lookup IP 1322 my $rev = gethostbyaddr(inet_aton($http_host), AF_INET); 1323 $http_host = $rev if ($rev); 1324 } 1325$http_host =~ s/^(www|ftp|mail)\.//; 1326my (@froms, @doms); 1327my $server_name = $config{'server_name'} || ""; 1328if ($server_name eq 'ldap') { 1329 # Special mode - the From: addresses just come from LDAP 1330 my $entry = &get_user_ldap(); 1331 push(@froms, $entry->get_value("mail")); 1332 push(@froms, $entry->get_value("mailAlternateAddress")); 1333 } 1334elsif ($remote_user =~ /\@/) { 1335 # From: address comes from username, which has an @ in it 1336 @froms = ( $remote_user ); 1337 } 1338else { 1339 # Work out From: addresses from hostname 1340 my $hostname = $server_name eq '*' ? $http_host : 1341 $server_name eq '' ? &get_system_hostname() : 1342 $server_name; 1343 @doms = split(/\s+/, $hostname); 1344 my $ru = $remote_user; 1345 $ru =~ s/\.\Q$http_host\E$//; 1346 if ($http_host =~ /^([^\.]+)/) { 1347 $ru =~ s/\.\Q$1\E//; 1348 } 1349 @froms = map { $ru.'@'.$_ } @doms; 1350 } 1351my @mfroms; 1352if ($config{'from_map'}) { 1353 # Lookup username in from address mapping file, to get email. 1354 open(my $MAP, "<", $config{'from_map'}); 1355 while(<$MAP>) { 1356 s/\r|\n//g; 1357 s/#.*$//; 1358 if ($remote_user !~ /\@/) { 1359 if (/^\s*(\S+)\s+(\S+\@\S+)/ && 1360 ($1 eq $remote_user || &indexof($1, @froms) >= 0) && 1361 $config{'from_format'} == 0) { 1362 # Username on LHS matches 1363 push(@mfroms, $2); 1364 } 1365 elsif (/^\s*(\S+\@\S+)\s+(\S+)/ && 1366 ($2 eq $remote_user || &indexof($2, @froms) >= 0) && 1367 $config{'from_format'} == 1) { 1368 # Username on RHS matches 1369 push(@mfroms, $1); 1370 } 1371 # For regular default vitual-server user 1372 # - abuse@domain.com domain@domain.com 1373 # - hostmaster@domain.com domain@domain.com 1374 # - postmaster@domain.com domain@domain.com 1375 # - webmaster@domain.com domain@domain.com 1376 elsif (/^\s*([\w\-]+@[\w\-\.]+)\s+([\w\-]+)[@-][\w\-\.]+/ && 1377 ($2 eq $remote_user) && 1378 $config{'from_format'} == 1) { 1379 # Username on RHS matches 1380 push(@mfroms, $1); 1381 } 1382 } 1383 else { 1384 # For additional vitual-server user 1385 # - user1@domain.com user1-domain.com 1386 # - user1-alias1@domain.com user1@domain.com 1387 # - user1-alias2@domain.com user1-domain.com 1388 my $remote_user__ = $remote_user; 1389 $remote_user__ =~ s/@/-/; 1390 if (/^\s*([\w\-]+@[\w\-\.]+)\s+([\w\-]+[@-][\w\-\.]+)/ && 1391 ($2 eq $remote_user || $2 eq $remote_user__) && 1392 $config{'from_format'} == 1) { 1393 push(@mfroms, $1); 1394 } 1395 } 1396 } 1397 close($MAP); 1398 1399 # Prefer email where mailbox matches username 1400 @mfroms = sort { my ($abox, $adom) = split(/\@/, $a); 1401 my ($bbox, $bdom) = split(/\@/, $b); 1402 $remote_user =~ /\Q$abox\E/ && 1403 $remote_user !~ /\Q$bbox\E/ ? -1 : 1404 $remote_user !~ /\Q$abox\E/ && 1405 $remote_user =~ /\Q$bbox\E/ ? 1 : 0 } @mfroms; 1406 } 1407if (@mfroms > 0) { 1408 # Got some results from mapping file .. use them 1409 if ($remote_user =~ /\@/) { 1410 # But still keep email-style login as the default 1411 @froms = ( $froms[0], @mfroms ); 1412 } 1413 else { 1414 @froms = @mfroms; 1415 } 1416 } 1417 1418# Store only unique from addresses 1419my %fromsu = (); 1420@froms = grep { !$fromsu{$_} ++ } @froms; 1421 1422# Add user's real name 1423my $ureal = $remote_user_info[6]; 1424my %real_names = map { $_->[0], $_->[1] } &list_addresses(); 1425$ureal =~ s/,.*$//; 1426foreach my $f (@froms) { 1427 if ($real_names{$f}) { 1428 $f = "$real_names{$f} <$f>"; 1429 } 1430 elsif ($ureal && $userconfig{'real_name'}) { 1431 $f = "\"$ureal\" <$f>"; 1432 } 1433 } 1434return (\@froms, \@doms); 1435} 1436 1437# update_delivery_notification(&mail, &folder) 1438# If the given mail is a DSN, update the original email so we know it has 1439# been read 1440my (%dsnreplies, %delreplies); 1441sub update_delivery_notification 1442{ 1443my ($mail, $folder) = @_; 1444return 0 if ($mail->{'header'}->{'content-type'} !~ /multipart\/report/i); 1445my $mid = $mail->{'header'}->{'message-id'}; 1446&open_dsn_hash(); 1447if ($dsnreplies{$mid} || $delreplies{$mid}) { 1448 # We have already done this DSN 1449 return 0; 1450 } 1451if (!defined($mail->{'body'}) && !$mail->{'parsed'} && 1452 defined($mail->{'idx'})) { 1453 # This message has no body, perhaps because one wasn't fetched .. 1454 my @mail = &mailbox_list_mails($mail->{'idx'}, $mail->{'idx'}, 1455 $folder); 1456 $mail = $mail[$mail->{'idx'}]; 1457 } 1458$dsnreplies{$mid} = $delreplies{$mid} = 1; 1459 1460# Find the delivery or disposition status attachment 1461&parse_mail($mail); 1462my ($dsnattach) = grep { $_->{'header'}->{'content-type'} =~ /message\/disposition-notification/i } @{$mail->{'attach'}}; 1463my ($delattach) = grep { $_->{'header'}->{'content-type'} =~ /message\/delivery-status/i } @{$mail->{'attach'}}; 1464 1465my $omid; 1466if ($dsnattach) { 1467 # Update the read status for the original message 1468 if ($dsnattach->{'data'} =~ /Original-Message-ID:\s*(.*)/) { 1469 $omid = $1; 1470 } 1471 else { 1472 return 0; 1473 } 1474 my ($faddr) = &split_addresses($mail->{'header'}->{'from'}); 1475 &add_address_to_hash(\%dsnreplies, $omid, $faddr->[0]); 1476 return 1; 1477 } 1478elsif ($delattach) { 1479 # Update the delivery status for the original message, which will be 1480 # in a separate attachment 1481 my ($origattach) = grep { $_->{'header'}->{'content-type'} =~ /text\/rfc822-headers|message\/rfc822/i } @{$mail->{'attach'}}; 1482 return 0 if (!$origattach); 1483 my $origmail = &extract_mail($origattach->{'data'}); 1484 my $omid = $origmail->{'header'}->{'message-id'}; 1485 return 0 if (!$omid); 1486 my ($faddr) = &split_addresses($origmail->{'header'}->{'from'}); 1487 my $ds = &parse_delivery_status($delattach->{'data'}); 1488 if ($ds->{'status'} =~ /^2\./) { 1489 &add_address_to_hash(\%delreplies, $omid, $faddr->[0]); 1490 } 1491 elsif ($ds->{'status'} =~ /^5\./) { 1492 &add_address_to_hash(\%delreplies, $omid, "!".$faddr->[0]); 1493 } 1494 } 1495else { 1496 return 0; 1497 } 1498} 1499 1500# add_address_to_hash(&hash, messageid, address) 1501sub add_address_to_hash 1502{ 1503my @cv = split(/\s+/, $_[0]->{$_[1]}); 1504my $idx = &indexof($_[2], @cv); 1505if ($idx < 0) { 1506 $_[0]->{$_[1]} .= " " if (@cv); 1507 $_[0]->{$_[1]} .= time()." ".$_[2]; 1508 } 1509} 1510 1511# open_dsn_hash() 1512# Ensure the %dsnreplies and %delreplies hashes are tied 1513my $opened_dsnreplies; 1514my $opened_delreplies; 1515sub open_dsn_hash 1516{ 1517if (!$opened_dsnreplies) { 1518 &open_dbm_db(\%dsnreplies, 1519 "$user_module_config_directory/dsnreplies", 0600); 1520 $opened_dsnreplies = 1; 1521 } 1522if (!$opened_delreplies) { 1523 &open_dbm_db(\%delreplies, 1524 "$user_module_config_directory/delreplies", 0600); 1525 $opened_delreplies = 1; 1526 } 1527} 1528 1529# open_read_hash() 1530# Ensure the %read hash is tied 1531my $opened_read; 1532my %read; # XXX This is sniffy. Used across bounderies. 1533sub open_read_hash 1534{ 1535if (!$opened_read) { 1536 &open_dbm_db(\%read, "$user_module_config_directory/read", 0600); 1537 $opened_read = 1; 1538 } 1539} 1540 1541# get_special_folder() 1542# Returns the virtual folder containing messages marked as 'special', or undef 1543# if not defined yet. 1544my $special_folder_cache; 1545sub get_special_folder 1546{ 1547if (defined($special_folder_cache)) { 1548 return $special_folder_cache || undef; 1549 } 1550else { 1551 # Find for real 1552 my @folders = &list_folders(); 1553 my ($s) = grep { $_->{'type'} == 6 && 1554 $_->{'id'} == $special_folder_id } @folders; 1555 $special_folder_cache = $s ? $s : ""; 1556 return $s; 1557 } 1558} 1559 1560# get_mail_read(&folder, &mail) 1561# Returns the read-mode flag for some email (0=unread, 1=read, 2=special) 1562# Checks the special folder first, then the read DBM 1563my %get_mail_read_cache; 1564sub get_mail_read 1565{ 1566my ($folder, $mail) = @_; 1567if (defined($get_mail_read_cache{$mail->{'id'}})) { 1568 # Already checked in this run 1569 return $get_mail_read_cache{$mail->{'id'}}; 1570 } 1571my $sfolder = &get_special_folder(); 1572my ($realfolder, $realid) = &get_underlying_folder($folder, $mail); 1573my $special = 0; 1574if ($sfolder) { 1575 # Is it in the special folder? If so, definately special 1576 my ($spec) = grep { $_->[0] eq $realfolder && 1577 $_->[1] eq $realid } @{$sfolder->{'members'}}; 1578 if ($spec) { 1579 $special = 2; 1580 } 1581 } 1582my $rv; 1583if ($realfolder->{'flags'}) { 1584 # For folders which can store the flags in the message itself (such 1585 # as IMAP), use that 1586 $rv = ($mail->{'read'} ? 1 : 0) + 1587 ($mail->{'special'} ? 2 : 0) + 1588 ($mail->{'replied'} ? 4 : 0); 1589 } 1590if (!$realfolder->{'flags'} || ($realfolder->{'flags'} == 2 && !$rv)) { 1591 # Check read hash if this folder doesn't support flagging, or if 1592 # it couldn't give us an answer. 1593 &open_read_hash(); 1594 $rv = int($read{$mail->{'header'}->{'message-id'}}); 1595 } 1596$rv = ($rv|$special); 1597$get_mail_read_cache{$mail->{'id'}} = $rv; 1598return $rv; 1599} 1600 1601# set_mail_read(&folder, &mail, read) 1602# Sets the read flag for some email, possibly updating the special folder. 1603# Read flags are 0=unread, 1=read, 2=special. Add 4 for replied. 1604sub set_mail_read 1605{ 1606my ($folder, $mail, $read) = @_; 1607my ($realfolder, $realid); 1608if ($mail->{'id'}) { 1609 my $sfolder = &get_special_folder(); 1610 ($realfolder, $realid) = &get_underlying_folder($folder, $mail); 1611 print DEBUG "id=$mail->{'id'} realid=$realid\n"; 1612 my $spec; 1613 if ($sfolder || ($read&2) != 0) { 1614 if ($sfolder) { 1615 # Is it already there? 1616 ($spec) = grep { $_->[0] eq $realfolder && 1617 $_->[1] eq $realid } 1618 @{$sfolder->{'members'}}; 1619 print DEBUG "spec=$spec\n"; 1620 } 1621 if (($read&2) != 0 && !$spec) { 1622 # Add to special folder 1623 if (!$sfolder) { 1624 # Create first 1625 $sfolder = { 'id' => $special_folder_id, 1626 'type' => 6, 1627 'name' => $text{'mail_special'}, 1628 'delete' => 1, 1629 'members' => [ [ 1630 $realfolder, $realid ] ], 1631 }; 1632 &save_folder($sfolder); 1633 $special_folder_cache = $sfolder; 1634 } 1635 else { 1636 # Just add 1637 push(@{$sfolder->{'members'}}, 1638 [ $realfolder,$realid ]); 1639 &save_folder($sfolder, $sfolder); 1640 } 1641 } 1642 elsif (($read&2) == 0 && $spec) { 1643 # Remove from special folder 1644 $sfolder->{'members'} = 1645 [ grep { $_ ne $spec } @{$sfolder->{'members'}} ]; 1646 &save_folder($sfolder, $sfolder); 1647 } 1648 } 1649 if ($realfolder->{'flags'}) { 1650 # Set the flag in the email itself, such as on an IMAP server 1651 my $mail->{'id'} = $realid; # So that IMAP can find it by UID 1652 &mailbox_set_read_flag($realfolder, $mail, 1653 ($read&1), # Read 1654 ($read&2), # Special 1655 ($read&4)); # Replied 1656 if ($realid ne $mail->{'id'} && ($read&2) && !$spec) { 1657 # ID changed .. fix in special folder 1658 ($spec) = grep { $_->[0] eq $realfolder && 1659 $_->[1] eq $realid } 1660 @{$sfolder->{'members'}}; 1661 if ($spec) { 1662 $spec->[1] = $mail->{'id'}; 1663 &save_folder($sfolder, $sfolder); 1664 } 1665 } 1666 } 1667 } 1668if (!$realfolder || !$realfolder->{'flags'} || $realfolder->{'flags'} == 2) { 1669 # Update read hash 1670 &open_read_hash(); 1671 if ($read == 0) { 1672 delete($read{$mail->{'header'}->{'message-id'}}); 1673 } 1674 else { 1675 $read{$mail->{'header'}->{'message-id'}} = $read; 1676 } 1677 } 1678if ($mail->{'id'}) { 1679 $get_mail_read_cache{$mail->{'id'}} = $read; 1680 } 1681} 1682 1683# get_underlying_folder(&folder, &mail) 1684# For mail in some virtual folder, returns the real folder and ID 1685sub get_underlying_folder 1686{ 1687my ($realfolder, $mail) = @_; 1688my $realid = $mail->{'id'}; 1689while($realfolder->{'type'} == 5 || $realfolder->{'type'} == 6) { 1690 my ($sfn, $sid) = split(/\t+/, $realid, 2); 1691 $realfolder = &find_subfolder($realfolder, $sfn); 1692 $realid = $sid; 1693 } 1694return ($realfolder, $realid); 1695} 1696 1697# spam_report_cmd() 1698# Returns a command for reporting spam, or undef if none 1699sub spam_report_cmd 1700{ 1701my %sconfig = &foreign_config("spam"); 1702if ($config{'spam_report'} eq 'sa_learn') { 1703 return &has_command($sconfig{'sa_learn'}) ? "$sconfig{'sa_learn'} --spam --mbox" : undef; 1704 } 1705elsif ($config{'spam_report'} eq 'spamassassin') { 1706 return &has_command($sconfig{'spamassassin'}) ? "$sconfig{'spamassassin'} --r" : undef; 1707 } 1708else { 1709 return &has_command($sconfig{'sa_learn'}) ? 1710 "$sconfig{'sa_learn'} --spam --mbox" : 1711 &has_command($sconfig{'spamassassin'}) ? 1712 "$sconfig{'spamassassin'} --r" : undef; 1713 } 1714} 1715 1716# ham_report_cmd() 1717# Returns a command for reporting ham, or undef if none 1718sub ham_report_cmd 1719{ 1720my %sconfig = &foreign_config("spam"); 1721return &has_command($sconfig{'sa_learn'}) ? "$sconfig{'sa_learn'} --ham --mbox" : undef; 1722} 1723 1724# can_report_spam(&folder) 1725sub can_report_spam 1726{ 1727return (&foreign_available("spam") || $config{'spam_always'}) && 1728 &foreign_installed("spam") && 1729 !$_[0]->{'sent'} && !$_[0]->{'drafts'} && 1730 &spam_report_cmd(); 1731} 1732 1733# can_report_ham(&folder) 1734sub can_report_ham 1735{ 1736return (&foreign_available("spam") || $config{'spam_always'}) && 1737 &foreign_installed("spam") && 1738 !$_[0]->{'sent'} && !$_[0]->{'drafts'} && 1739 &ham_report_cmd(); 1740} 1741 1742# filter_by_status(&messages, status) 1743# Returns only messages with a particular status 1744sub filter_by_status 1745{ 1746my (@rv, $mail); 1747&open_read_hash(); 1748foreach my $mail (@{$_[0]}) { 1749 my $mid = $mail->{'header'}->{'message-id'}; 1750 if ($read{$mid} == $_[1]) { 1751 push(@rv, $mail); 1752 } 1753 } 1754return @rv; 1755} 1756 1757# show_mailbox_buttons(number, &folders, current-folder, &mail) 1758# Prints HTML for buttons to appear above or below a mail list 1759sub show_mailbox_buttons 1760{ 1761my ($num, $folders, $folder, $mail) = @_; 1762my $spacer = " \n"; 1763 1764# Compose button 1765if ($userconfig{'open_mode'}) { 1766 # Compose button needs to pop up a window 1767 print &ui_submit($text{'mail_compose'}, "new", undef, 1768 "onClick='window.open(\"reply_mail.cgi?new=1\", \"compose\", \"toolbar=no,menubar=no,scrollbars=yes,width=1024,height=768\"); return false'>"); 1769 } 1770else { 1771 # Compose button can just submit and redirect 1772 print &ui_submit($text{'mail_compose'}, "new"); 1773 } 1774print $spacer; 1775 1776# Forward selected 1777if (@$mail) { 1778 if ($userconfig{'open_mode'}) { 1779 print &ui_submit($text{'mail_forward'}, "forward", undef, 1780 "onClick='args = \"folder=$folder->{'index'}\"; for(i=0; i<form.d.length; i++) { if (form.d[i].checked) { args += \"&mailforward=\"+escape(form.d[i].value); } } window.open(\"reply_mail.cgi?\"+args, \"compose\", \"toolbar=no,menubar=no,scrollbars=yes,width=1024,height=768\"); return false'>"); 1781 } 1782 else { 1783 # Forward button can just be a normal submit 1784 print &ui_submit($text{'mail_forward'}, "forward"); 1785 } 1786 print $spacer; 1787 } 1788 1789# Mark as buttons 1790if (@$mail) { 1791 foreach my $i (0 .. 2) { 1792 print &ui_submit($text{'view_markas'.$i}, 'markas'.$i); 1793 } 1794 print $spacer; 1795 } 1796 1797# Copy/move to folder 1798if (@$mail && @$folders > 1) { 1799 print &movecopy_select($_[0], $folders, $folder); 1800 print $spacer; 1801 } 1802 1803# Delete 1804if (@$mail) { 1805 print &ui_submit($text{'mail_delete'}, "delete"); 1806 print $spacer; 1807 } 1808 1809# Blacklist / report spam 1810if (@$mail && ($folder->{'spam'} || $userconfig{'spam_buttons'} =~ /list/ && 1811 &can_report_spam($folder))) { 1812 print &ui_submit($text{'mail_black'}, "black"); 1813 if ($userconfig{'spam_del'}) { 1814 print &ui_submit($text{'view_razordel'}, "razor"); 1815 } 1816 else { 1817 print &ui_submit($text{'view_razor'}, "razor"); 1818 } 1819 print $spacer; 1820 } 1821 1822# Whitelist / report ham 1823if (@$mail && ($folder->{'spam'} || $userconfig{'ham_buttons'} =~ /list/ && 1824 &can_report_ham($folder))) { 1825 if ($userconfig{'white_move'} && $folder->{'spam'}) { 1826 print &ui_submit($text{'mail_whitemove'}, "white"); 1827 } 1828 else { 1829 print &ui_submit($text{'mail_white'}, "white"); 1830 } 1831 if ($userconfig{'ham_move'} && $folder->{'spam'}) { 1832 print &ui_submit($text{'view_hammove'}, "ham"); 1833 } 1834 else { 1835 print &ui_submit($text{'view_ham'}, "ham"); 1836 } 1837 print $spacer; 1838 } 1839 1840if ($userconfig{'open_mode'}) { 1841 # Show mass open button 1842 print &ui_submit($text{'mail_open'}, "new", undef, 1843 "onClick='for(i=0; i<form.d.length; i++) { if (form.d[i].checked) { window.open(\"view_mail.cgi?folder=$folder->{'index'}&idx=\"+escape(form.d[i].value), \"view\"+i, \"toolbar=no,menubar=no,scrollbars=yes,width=1024,height=768\"); } } return false'>"); 1844 print $spacer; 1845 } 1846 1847print "<br>\n"; 1848} 1849 1850# expand_to(list) 1851# Given a string containing multiple email addresses and group names, 1852# expand out the group names (if any) 1853my (%address_groups, %real_expand_names); 1854my $expanded; 1855sub expand_to 1856{ 1857$_[0] =~ s/\r//g; 1858$_[0] =~ s/\n/ /g; 1859if (!%address_groups) { 1860 %address_groups = map { $_->[0], $_->[1] } &list_address_groups(); 1861 } 1862if ($userconfig{'real_expand'}) { 1863 if (!%real_expand_names) { 1864 %real_expand_names = map { $_->[1], $_->[0] } 1865 grep { $_->[1] } &list_addresses() 1866 } 1867 } 1868my @addrs = &split_addresses($_[0]); 1869my (@alladdrs, $a, $expanded); 1870foreach my $a (@addrs) { 1871 if (defined($address_groups{$a->[0]})) { 1872 push(@alladdrs, &split_addresses($address_groups{$a->[0]})); 1873 $expanded++; 1874 } 1875 elsif (defined($real_expand_names{$a->[0]})) { 1876 push(@alladdrs, &split_addresses($real_expand_names{$a->[0]})); 1877 $expanded++; 1878 } 1879 else { 1880 push(@alladdrs, $a); 1881 } 1882 } 1883return $expanded ? join(", ", map { $_->[2] } @alladdrs) 1884 : $_[0]; 1885} 1886 1887# connect_qmail_ldap([return-error]) 1888# Connect to the LDAP server used for Qmail. Returns an LDAP handle on success, 1889# or an error message on failure. 1890sub connect_qmail_ldap 1891{ 1892eval "use Net::LDAP"; 1893if ($@) { 1894 my $err = &text('ldap_emod', "<tt>Net::LDAP</tt>"); 1895 if ($_[0]) { return $err; } 1896 else { &error($err); } 1897 } 1898 1899# Connect to server 1900my $port = $config{'ldap_port'} || 389; 1901my $ldap = Net::LDAP->new($config{'ldap_host'}, port => $port); 1902if (!$ldap) { 1903 my $err = &text('ldap_econn', 1904 "<tt>$config{'ldap_host'}</tt>","<tt>$port</tt>"); 1905 if ($_[0]) { return $err; } 1906 else { &error($err); } 1907 } 1908 1909# Start TLS if configured 1910if ($config{'ldap_tls'}) { 1911 $ldap->start_tls(); 1912 } 1913 1914# Login 1915my $mesg; 1916if ($config{'ldap_login'}) { 1917 $mesg = $ldap->bind(dn => $config{'ldap_login'}, 1918 password => $config{'ldap_pass'}); 1919 } 1920else { 1921 $mesg = $ldap->bind(anonymous => 1); 1922 } 1923if (!$mesg || $mesg->code) { 1924 my $err = &text('ldap_elogin', "<tt>$config{'ldap_host'}</tt>", 1925 "<tt>$config{'ldap_login'}</tt>", 1926 $mesg ? $mesg->error : "Unknown error"); 1927 if ($_[0]) { return $err; } 1928 else { &error($err); } 1929 } 1930return $ldap; 1931} 1932 1933# get_user_ldap() 1934# Looks up the LDAP information for the current mailbox user, and returns a 1935# Net::LDAP::Entry object. 1936sub get_user_ldap 1937{ 1938my $ldap = &connect_qmail_ldap(); 1939my $rv = $ldap->search(base => $config{'ldap_base'}, 1940 filter => "(uid=$remote_user)"); 1941&error("Failed to get LDAP entry : ",$rv->error) if ($rv->code); 1942my ($u) = $rv->all_entries(); 1943&error("Could not find LDAP entry") if (!$u); 1944$ldap->unbind(); 1945return $u; 1946} 1947 1948# would_exceed_quota(&folder, &mail, ...) 1949# Checks if the addition of a given email messages 1950# exceed any quotas. Called when saving a draft or copying an email. 1951# Returns undef if OK, or an error message 1952sub would_exceed_quota 1953{ 1954my ($folder, @mail) = @_; 1955 1956# Get quotas in force 1957my ($total, $count, $totalquota, $countquota) = &get_user_quota(); 1958return undef if (!$totalquota && !$countquota); 1959 1960# Work out how much we are adding 1961my $m; 1962my $adding = 0; 1963foreach my $m (@mail) { 1964 $adding += ($m->{'size'} || &mail_size($m)); 1965 } 1966 1967# Check against size limit 1968if ($totalquota && $total + $adding > $totalquota) { 1969 return &text('quota_inbox', &nice_size($totalquota)); 1970 } 1971 1972# Check against count limit 1973if ($countquota && $count + scalar(@mail) > $countquota) { 1974 return &text('quota_inbox2', $countquota); 1975 } 1976 1977return undef; 1978} 1979 1980# get_user_quota() 1981# If any quotas are in force, returns the total size of all folders, the total 1982# number of messages, the maximum size, and the maximum number of messages 1983sub get_user_quota 1984{ 1985return ( ) if (!$config{'ldap_quotas'} && !$config{'max_quota'}); 1986 1987# Work out current size of all local folders 1988my $f; 1989my $total = 0; 1990my $count = 0; 1991foreach my $f (&list_folders()) { 1992 if ($f->{'type'} == 0 || $f->{'type'} == 1 || $f->{'type'} == 3) { 1993 $total += &folder_size($f); 1994 $count += &mailbox_folder_size($f); 1995 } 1996 } 1997 1998# Get the configured quota 1999my $configquota = $config{'max_quota'}; 2000 2001# Get the LDAP limit 2002my $ldapquota; 2003my $ldapcount; 2004if ($config{'ldap_host'} && $config{'ldap_quotas'}) { 2005 my $entry = &get_user_ldap(); 2006 $ldapquota = $entry->get_value("mailQuotaSize"); 2007 $ldapcount = $entry->get_value("mailQuotaCount"); 2008 } 2009 2010my $quota = defined($configquota) && defined($ldapquota) ? 2011 min($configquota, $ldapquota) : 2012 defined($configquota) ? $configquota : 2013 defined($ldapquota) ? $ldapquota : undef; 2014return ($total, $count, $quota, $ldapcount); 2015} 2016 2017sub min 2018{ 2019return $_[0] < $_[1] ? $_[0] : $_[1]; 2020} 2021 2022# get_sort_field(&folder) 2023# Returns the field and direction on which sorting is done for the current user 2024sub get_sort_field 2025{ 2026my ($folder) = @_; 2027return ( ) if (!$folder->{'sortable'}); 2028my $file = &folder_name($folder); 2029$file =~ s/\//_/g; 2030my %sort; 2031if (&read_file_cached("$user_module_config_directory/sort.$file", \%sort)) { 2032 return ($sort{'field'}, $sort{'dir'}); 2033 } 2034return ( ); 2035} 2036 2037# save_sort_field(&folder, field, dir) 2038sub save_sort_field 2039{ 2040my $file = &folder_name($_[0]); 2041$file =~ s/\//_/g; 2042my %sort = ( 'field' => $_[1], 'dir' => $_[2] ); 2043&write_file("$user_module_config_directory/sort.$file", \%sort); 2044} 2045 2046# field_sort_link(title, field, folder-idx, start) 2047# Returns HTML for a link to switch sorting mode 2048sub field_sort_link 2049{ 2050my ($title, $field, $folder, $start) = @_; 2051my ($sortfield, $sortdir) = &get_sort_field($folder); 2052my $dir = $sortfield eq $field ? !$sortdir : 0; 2053my $img = $sortfield eq $field && $dir ? "sortascgrey.gif" : 2054 $sortfield eq $field && !$dir ? "sortdescgrey.gif" : 2055 $dir ? "sortasc.gif" : "sortdesc.gif"; 2056if ($folder->{'sortable'} && $userconfig{'show_sort'}) { 2057 return "<a href='sort.cgi?field=".&urlize($field)."&dir=".&urlize($dir)."&folder=".&urlize($folder->{'index'})."&start=".&urlize($start)."'>$title <img valign=middle src=../images/$img border=0>"; 2058 } 2059else { 2060 return $title; 2061 } 2062} 2063 2064# view_mail_link(&folder, id, start, from-to-text) 2065sub view_mail_link 2066{ 2067my ($folder, $id, $start, $txt) = @_; 2068my $qid = &urlize($id); 2069my $qstart = &urlize($start); 2070my $url = "view_mail.cgi?start=$qstart&id=$qid&folder=$folder->{'index'}"; 2071if ($userconfig{'open_mode'}) { 2072 return "<a href='' onClick='window.open(\"$url\", \"viewmail\", \"toolbar=no,menubar=no,scrollbars=yes,width=1024,height=768\"); return false'>". 2073 &simplify_from($txt)."</a>"; 2074 } 2075else { 2076 return "<a href='$url'>".&simplify_from($txt)."</a>"; 2077 } 2078} 2079 2080# mail_page_header(title, headstuff, bodystuff) 2081sub mail_page_header 2082{ 2083if ($userconfig{'open_mode'}) { 2084 &popup_header(@_); 2085 } 2086else { 2087 &ui_print_header(undef, $_[0], "", undef, 0, 0, 0, undef, $_[1], $_[2]); 2088 } 2089} 2090 2091# mail_page_footer(link, text, ...) 2092sub mail_page_footer 2093{ 2094if ($userconfig{'open_mode'}) { 2095 &popup_footer(); 2096 } 2097else { 2098 &ui_print_footer(@_); 2099 } 2100} 2101 2102# get_auto_schedule(&folder) 2103# Returns the automatic schedule structure for the given folder 2104sub get_auto_schedule 2105{ 2106my ($folder) = @_; 2107my $id = $folder->{'id'} || &urlize($folder->{'file'}); 2108my %rv; 2109&read_file("$user_module_config_directory/$id.sched", \%rv) || 2110 return undef; 2111return \%rv; 2112} 2113 2114# save_auto_schedule(&folder, &sched) 2115# Updates the automatic schedule structure for the given folder 2116sub save_auto_schedule 2117{ 2118my ($folder, $sched) = @_; 2119my $id = $folder->{'id'} || &urlize($folder->{'file'}); 2120if ($sched) { 2121 &write_file("$user_module_config_directory/$id.sched", $sched); 2122 } 2123else { 2124 unlink("$user_module_config_directory/$id.sched"); 2125 } 2126} 2127 2128# setup_auto_cron() 2129# Creates the Cron job that runs auto.pl 2130sub setup_auto_cron 2131{ 2132&foreign_require("cron", "cron-lib.pl"); 2133my @jobs = &cron::list_cron_jobs(); 2134my ($job) = grep { $_->{'command'} eq $auto_cmd && 2135 $_->{'user'} eq $remote_user } @jobs; 2136if (!$job) { 2137 $job = { 'command' => $auto_cmd, 2138 'active' => 1, 2139 'user' => $remote_user, 2140 'mins' => int(rand()*60), 2141 'hours' => '*', 2142 'days' => '*', 2143 'months' => '*', 2144 'weekdays' => '*' }; 2145 &cron::create_cron_job($job); 2146 } 2147&cron::create_wrapper($auto_cmd, $module_name, "auto.pl"); 2148} 2149 2150# addressbook_to_whitelist() 2151# If SpamAssassin is installed, update the user's whitelist with all 2152# addressbook entries 2153sub addressbook_to_whitelist 2154{ 2155if ($userconfig{'white_book'} && &foreign_installed("spam")) { 2156 &foreign_require("spam", "spam-lib.pl"); 2157 my $conf = &spam::get_config(); 2158 my @white = &spam::find_value("whitelist_from", $conf); 2159 my %white = map { lc($_), 1 } @white; 2160 foreach my $a (&list_addresses()) { 2161 if (!$white{lc($a->[0])}) { 2162 push(@white, $a->[0]); 2163 } 2164 } 2165 &spam::save_directives($conf, "whitelist_from", \@white, 1); 2166 &flush_file_lines(); 2167 } 2168} 2169 2170# addressbook_add_whitelist(address, ...) 2171# Add some email address to the whitelist 2172sub addressbook_add_whitelist 2173{ 2174my (@addrs) = @_; 2175if (&foreign_installed("spam")) { 2176 &foreign_require("spam", "spam-lib.pl"); 2177 my $conf = &spam::get_config(); 2178 my @white = &spam::find_value("whitelist_from", $conf); 2179 my %white = map { lc($_), 1 } @white; 2180 foreach my $a (@addrs) { 2181 if (!$white{lc($a)}) { 2182 push(@white, $a); 2183 } 2184 } 2185 &spam::save_directives($conf, "whitelist_from", \@white, 1); 2186 &flush_file_lines(); 2187 } 2188} 2189 2190# addressbook_remove_whitelist(address) 2191# Delete some address from the whitelist 2192sub addressbook_remove_whitelist 2193{ 2194my ($addr) = @_; 2195if ($userconfig{'white_book'} && &foreign_installed("spam")) { 2196 &foreign_require("spam", "spam-lib.pl"); 2197 my $conf = &spam::get_config(); 2198 my @white = &spam::find_value("whitelist_from", $conf); 2199 @white = grep { lc($_) ne lc($addr) } @white; 2200 &spam::save_directives($conf, "whitelist_from", \@white, 1); 2201 &flush_file_lines(); 2202 } 2203} 2204 2205# left_right_align(left, right) 2206# Returns a table for left and right aligning some HTML 2207sub left_right_align 2208{ 2209my ($l, $r) = @_; 2210return "<table cellpadding=0 cellspacing=0 width=100%><tr><td align=left>$l</td><td align=right>$r</td></tr></table>"; 2211} 2212 2213# Returns 1 if downloading all attachment is possible 2214sub can_download_all 2215{ 2216return &has_command("zip"); 2217} 2218 2219# select_status_link(name, form, &folder, &mails, start, end, status, label) 2220# Returns HTML for selecting messages 2221sub select_status_link 2222{ 2223my ($name, $formno, $folder, $mail, $start, $end, $status, $label) = @_; 2224$formno = int($formno); 2225my @sel; 2226for(my $i=$start; $i<=$end; $i++) { 2227 my $m = $mail->[$i]; 2228 my $read = &get_mail_read($folder, $m); 2229 if ($status == 0 && !($read&1) || 2230 $status == 1 && ($read&1) || 2231 $status == 2 && ($read&2)) { 2232 push(@sel, $m->{'id'}); 2233 } 2234 } 2235return &select_rows_link($name, $formno, $label, \@sel); 2236} 2237 2238# address_link(address, id, subs) 2239# Turns an address into a link for adding it to the addressbook 2240sub address_link 2241{ 2242my ($addr, $id, $subs) = @_; 2243my $qid = &urlize($id); 2244## split_addresses() pattern-matches "[<>]", so 7-bit encodings 2245## such as ISO-2022-JP must be converted to EUC before feeding. 2246my $mw = &convert_header_for_display($addr, 0, 1); 2247my @addrs = &split_addresses(&eucconv($mw)); 2248my @rv; 2249my %inbook; 2250foreach my $a (@addrs) { 2251 ## TODO: is $inbook{} MIME or locale-encoded? 2252 if ($inbook{lc($a->[0])}) { 2253 push(@rv, &eucconv_and_escape($a->[2])); 2254 } 2255 else { 2256 ## name= will be EUC encoded now since split_addresses() 2257 ## is feeded with EUC converted value. 2258 push(@rv, "<a href='add_address.cgi?addr=".&urlize($a->[0]). 2259 "&name=".&urlize($a->[1])."&id=$qid". 2260 "&folder=$in{'folder'}&start=$in{'start'}$subs'>". 2261 &eucconv_and_escape($a->[2])."</a>"); 2262 } 2263 } 2264return join(" , ", @rv); 2265} 2266 2267# get_preferred_from_address() 2268# Returns the from address for the current user, which may come from their 2269# address book, or from the module config. Will include the real name too, 2270# where possible. 2271sub get_preferred_from_address 2272{ 2273my ($froms, $doms) = &list_from_addresses(); 2274my ($defaddr) = grep { $_->[3] == 2 } &list_addresses(); 2275if ($defaddr) { 2276 # From address book 2277 if ($defaddr->[1]) { 2278 # Has real name 2279 my $n = $defaddr->[1]; 2280 if ($n !~ /^[\000-\177]*$/) { 2281 $n = &encode_mimewords($n, 'Charset' => &get_charset()); 2282 } 2283 return "\"".$n."\" "."<".$defaddr->[0].">"; 2284 } 2285 else { 2286 # Just an address 2287 return $defaddr->[0]; 2288 } 2289 return $defaddr->[1] ? "\"$defaddr->[1]\" <$defaddr->[0]>" 2290 : $defaddr->[0]; 2291 } 2292else { 2293 # Account default 2294 return $froms->[0]; 2295 } 2296} 2297 2298# remove_own_email(addresses) 2299# Given a string containing email addresses, remove those belonging to the user 2300sub remove_own_email 2301{ 2302my ($addrs) = @_; 2303my @addrs = &split_addresses($addrs); 2304 2305# Build our own addresses 2306my %own; 2307foreach my $a (&list_addresses()) { 2308 $own{$a->[0]}++ if ($a->[3]); 2309 } 2310my ($froms) = &list_from_addresses(); 2311foreach my $f (@$froms) { 2312 my ($addr) = &split_addresses($f); 2313 $own{$addr->[0]}++; 2314 } 2315 2316# See what we have to remove 2317my @others = grep { !$own{$_->[0]} } @addrs; 2318if (scalar(@others) == scalar(@addrs) || !scalar(@others)) { 2319 # No need to change the string 2320 return $addrs; 2321 } 2322else { 2323 # Return just those left 2324 return join(", ", map { $_->[2] } @others); 2325 } 2326} 2327 2328# get_last_folder_id() 2329# Returns the ID of the folder last opened, or undef 2330sub get_last_folder_id 2331{ 2332my $rv = &read_file_contents($last_folder_file); 2333$rv =~ s/\r|\n//g; 2334return $rv; 2335} 2336 2337# save_last_folder_id(id|&folder) 2338# Saves the last accessed folder ID 2339sub save_last_folder_id 2340{ 2341my ($id) = @_; 2342$id = &folder_name($id) if (ref($id)); 2343if ($id ne $search_folder_id && $id ne &get_last_folder_id()) { 2344 no strict "subs"; 2345 if (&open_tempfile(LASTFOLDER, ">$last_folder_file", 1)) { 2346 &print_tempfile(LASTFOLDER, $id,"\n"); 2347 &close_tempfile(LASTFOLDER); 2348 } 2349 use strict "subs"; 2350 } 2351} 2352 23531; 2354