1# folders-lib.pl 2# Functions for dealing with mail folders in various formats 3 4$pop3_port = 110; 5$imap_port = 143; 6 7@index_fields = ( "subject", "from", "to", "date", "size", 8 "x-spam-status", "message-id" ); 9$create_cid_count = 0; 10 11# get_folder_cache_directory(&folder) 12# Returns a directory used to cache IMAP or POP3 files for some folder 13sub get_folder_cache_directory 14{ 15my ($folder) = @_; 16if ($user_module_config_directory) { 17 return $user_module_config_directory."/".$folder->{'id'}.".cache"; 18 } 19else { 20 my $rv = $module_config_directory."/".$folder->{'id'}.".cache"; 21 if (!-d $rv) { 22 $rv = $module_var_directory."/".$folder->{'id'}.".cache"; 23 } 24 return $rv; 25 } 26} 27 28# mailbox_list_mails(start, end, &folder, [headersonly], [&error]) 29# Returns an array whose size is that of the entire folder, with messages 30# in the specified range filled in. 31sub mailbox_list_mails 32{ 33my @mail; 34&switch_to_folder_user($_[2]); 35if ($_[2]->{'type'} == 0) { 36 # List a single mbox formatted file 37 @mail = &list_mails($_[2]->{'file'}, $_[0], $_[1]); 38 } 39elsif ($_[2]->{'type'} == 1) { 40 # List a qmail maildir 41 local $md = $_[2]->{'file'}; 42 @mail = &list_maildir($md, $_[0], $_[1], $_[3]); 43 } 44elsif ($_[2]->{'type'} == 2) { 45 # Get mail headers/body from a remote POP3 server 46 47 # Login first 48 local @rv = &pop3_login($_[2]); 49 if ($rv[0] != 1) { 50 # Failed to connect or login 51 if ($_[4]) { 52 @{$_[4]} = @rv; 53 return (); 54 } 55 elsif ($rv[0] == 0) { &error($rv[1]); } 56 else { &error(&text('save_elogin', $rv[1])); } 57 } 58 local $h = $rv[1]; 59 local @uidl = &pop3_uidl($h); 60 local %onserver = map { &safe_uidl($_), 1 } @uidl; 61 62 # Work out what range we want 63 local ($start, $end) = &compute_start_end($_[0], $_[1], scalar(@uidl)); 64 @mail = map { undef } @uidl; 65 66 # For each message in the range, get the headers or body 67 local ($i, $f, %cached, %sizeneed); 68 local $cd = &get_folder_cache_directory($_[2]); 69 if (opendir(CACHE, $cd)) { 70 while($f = readdir(CACHE)) { 71 if ($f =~ /^(\S+)\.body$/) { 72 $cached{$1} = 2; 73 } 74 elsif ($f =~ /^(\S+)\.headers$/) { 75 $cached{$1} = 1; 76 } 77 } 78 closedir(CACHE); 79 } 80 else { 81 mkdir($cd, 0700); 82 } 83 for($i=$start; $i<=$end; $i++) { 84 local $u = &safe_uidl($uidl[$i]); 85 if ($cached{$u} == 2 || $cached{$u} == 1 && $_[3]) { 86 # We already have everything that we need 87 } 88 elsif ($cached{$u} == 1 || !$_[3]) { 89 # We need to get the entire mail 90 &pop3_command($h, "retr ".($i+1)); 91 open(CACHE, ">", "$cd/$u.body"); 92 while(<$h>) { 93 s/\r//g; 94 last if ($_ eq ".\n"); 95 print CACHE $_; 96 } 97 close(CACHE); 98 unlink("$cd/$u.headers"); 99 $cached{$u} = 2; 100 } 101 else { 102 # We just need the headers 103 &pop3_command($h, "top ".($i+1)." 0"); 104 open(CACHE, ">", "$cd/$u.headers"); 105 while(<$h>) { 106 s/\r//g; 107 last if ($_ eq ".\n"); 108 print CACHE $_; 109 } 110 close(CACHE); 111 $cached{$u} = 1; 112 } 113 local $mail = &read_mail_file($cached{$u} == 2 ? 114 "$cd/$u.body" : "$cd/$u.headers"); 115 if ($cached{$u} == 1) { 116 if ($mail->{'body'} ne "") { 117 $mail->{'size'} = int($mail->{'body'}); 118 } 119 else { 120 $sizeneed{$i} = 1; 121 } 122 } 123 $mail->{'idx'} = $i; 124 $mail->{'id'} = $uidl[$i]; 125 $mail[$i] = $mail; 126 } 127 128 # Get sizes for mails if needed 129 if (%sizeneed) { 130 &pop3_command($h, "list"); 131 while(<$h>) { 132 s/\r//g; 133 last if ($_ eq ".\n"); 134 if (/^(\d+)\s+(\d+)/ && $sizeneed{$1-1}) { 135 # Add size to the mail cache 136 $mail[$1-1]->{'size'} = $2; 137 local $u = &safe_uidl($uidl[$1-1]); 138 open(CACHE, ">>", "$cd/$u.headers"); 139 print CACHE $2,"\n"; 140 close(CACHE); 141 } 142 } 143 } 144 145 # Clean up any cached mails that no longer exist on the server 146 foreach $f (keys %cached) { 147 if (!$onserver{$f}) { 148 unlink($cached{$f} == 1 ? "$cd/$f.headers" 149 : "$cd/$f.body"); 150 } 151 } 152 } 153elsif ($_[2]->{'type'} == 3) { 154 # List an MH directory 155 local $md = $_[2]->{'file'}; 156 @mail = &list_mhdir($md, $_[0], $_[1], $_[3]); 157 } 158elsif ($_[2]->{'type'} == 4) { 159 # Get headers and possibly bodies from an IMAP server 160 161 # Login and select the specified mailbox 162 local @rv = &imap_login($_[2]); 163 if ($rv[0] != 1) { 164 # Something went wrong 165 if ($_[4]) { 166 @{$_[4]} = @rv; 167 return (); 168 } 169 elsif ($rv[0] == 0) { &error($rv[1]); } 170 elsif ($rv[0] == 3) { &error(&text('save_emailbox', $rv[1])); } 171 elsif ($rv[0] == 2) { &error(&text('save_elogin2', $rv[1])); } 172 } 173 local $h = $rv[1]; 174 local $count = $rv[2]; 175 return () if (!$count); 176 $_[2]->{'lastchange'} = $rv[3] if ($rv[3]); 177 178 # Work out what range we want 179 local ($start, $end) = &compute_start_end($_[0], $_[1], $count); 180 @mail = map { undef } (0 .. $count-1); 181 182 # Get the headers or body of messages in the specified range 183 local @rv; 184 if ($_[3]) { 185 # Just the headers 186 @rv = &imap_command($h, 187 sprintf "FETCH %d:%d (RFC822.SIZE UID FLAGS RFC822.HEADER)", 188 $start+1, $end+1); 189 } 190 else { 191 # Whole messages 192 @rv = &imap_command($h, 193 sprintf "FETCH %d:%d (UID FLAGS BODY.PEEK[])", $start+1, $end+1); 194 } 195 196 # Parse the headers or whole messages that came back 197 local $i; 198 for($i=0; $i<@{$rv[1]}; $i++) { 199 # Extract the actual mail part 200 local $mail = &parse_imap_mail($rv[1]->[$i]); 201 if ($mail) { 202 $mail->{'idx'} = $start+$i; 203 $mail[$start+$i] = $mail; 204 } 205 } 206 } 207elsif ($_[2]->{'type'} == 5) { 208 # A composite folder, which combined two or more others. 209 210 # Work out exactly how big the total is 211 local ($sf, %len, $count); 212 foreach $sf (@{$_[2]->{'subfolders'}}) { 213 print DEBUG "working out size of ",&folder_name($sf),"\n"; 214 $len{$sf} = &mailbox_folder_size($sf); 215 $count += $len{$sf}; 216 } 217 218 # Work out what range we need 219 local ($start, $end) = &compute_start_end($_[0], $_[1], $count); 220 221 # Fetch the needed part of each sub-folder 222 local $pos = 0; 223 foreach $sf (@{$_[2]->{'subfolders'}}) { 224 local ($sfstart, $sfend); 225 local $sfn = &folder_name($sf); 226 $sfstart = $start - $pos; 227 $sfend = $end - $pos; 228 $sfstart = $sfstart < 0 ? 0 : 229 $sfstart >= $len{$sf} ? $len{$sf}-1 : $sfstart; 230 $sfend = $sfend < 0 ? 0 : 231 $sfend >= $len{$sf} ? $len{$sf}-1 : $sfend; 232 print DEBUG "getting mail from $sfstart to $sfend in $sfn\n"; 233 local @submail = 234 &mailbox_list_mails($sfstart, $sfend, $sf, $_[3]); 235 local $sm; 236 foreach $sm (@submail) { 237 if ($sm) { 238 # ID is the original folder and ID 239 $sm->{'id'} = $sfn."\t".$sm->{'id'}; 240 } 241 } 242 push(@mail, @submail); 243 $pos += $len{$sf}; 244 } 245 } 246elsif ($_[2]->{'type'} == 6) { 247 # A virtual folder, which just contains ids of mails in other folders 248 local $mems = $folder->{'members'}; 249 local ($start, $end) = &compute_start_end($_[0], $_[1], scalar(@$mems)); 250 251 # Build a map from sub-folder names to IDs in them 252 local (%wantmap, %namemap); 253 for(my $i=$start; $i<=$end; $i++) { 254 local $sf = $mems->[$i]->[0]; 255 local $sid = $mems->[$i]->[1]; 256 local $sfn = &folder_name($sf); 257 $namemap{$sfn} = $sf; 258 push(@{$wantmap{$sfn}}, [ $sid, $i ]); 259 } 260 261 # For each sub-folder, get the IDs we need, and put them into the 262 # return array at the right place 263 @mail = map { undef } (0 .. @$mems-1); 264 local $changed = 0; 265 foreach my $sfn (keys %wantmap) { 266 local $sf = $namemap{$sfn}; 267 local @wantids = map { $_->[0] } @{$wantmap{$sfn}}; 268 local @wantidxs = map { $_->[1] } @{$wantmap{$sfn}}; 269 local @sfmail = &mailbox_select_mails($sf, \@wantids, $_[3]); 270 for(my $i=0; $i<@sfmail; $i++) { 271 $mail[$wantidxs[$i]] = $sfmail[$i]; 272 if ($sfmail[$i]) { 273 # Original mail exists .. add to results 274 if ($sfmail[$i]->{'id'} ne $wantids[$i]) { 275 # Under new ID now - fix up index 276 print DEBUG "wanted ID ",$wantids[$i], 277 " got ",$sfmail[$i]->{'id'},"\n"; 278 local ($m) = grep { 279 $_->[1] eq $wantids[$i] } @$mems; 280 if ($m) { 281 $m->[1] = $sfmail[$i]->{'id'}; 282 $changed = 1; 283 } 284 } 285 $sfmail[$i]->{'idx'} = $wantidxs[$i]; 286 $sfmail[$i]->{'id'} = 287 $sfn."\t".$sfmail[$i]->{'id'}; 288 } 289 else { 290 # Take out of virtual folder index 291 print DEBUG "underlying email $sfn $wantids[$i] is gone!\n"; 292 $mems = [ grep { $_->[0] ne $sf || 293 $_->[1] ne $wantids[$i] } @$mems ]; 294 $changed = 1; 295 $mail[$wantidxs[$i]] = 'GONE'; 296 } 297 } 298 } 299 if ($changed) { 300 # Need to save virtual folder 301 $folder->{'members'} = $mems; 302 &save_folder($folder, $folder); 303 } 304 305 # Filter out messages that don't exist anymore 306 @mail = grep { $_ ne 'GONE' } @mail; 307 } 308elsif ($_[2]->{'type'} == 7) { 309 # MBX format folder 310 print DEBUG "listing MBX $_[2]->{'file'}\n"; 311 @mail = &list_mbxfile($_[2]->{'file'}, $_[0], $_[1]); 312 } 313&switch_from_folder_user($_[2]); 314return @mail; 315} 316 317# mailbox_select_mails(&folder, &ids, headersonly) 318# Returns only messages from a folder with unique IDs in the given array 319sub mailbox_select_mails 320{ 321local ($folder, $ids, $headersonly) = @_; 322my @mail; 323&switch_to_folder_user($_[0]); 324if ($folder->{'type'} == 0) { 325 # mbox folder 326 @mail = &select_mails($folder->{'file'}, $ids, $headersonly); 327 } 328elsif ($folder->{'type'} == 1) { 329 # Maildir folder 330 @mail = &select_maildir($folder->{'file'}, $ids, $headersonly); 331 } 332elsif ($folder->{'type'} == 3) { 333 # MH folder 334 @mail = &select_mhdir($folder->{'file'}, $ids, $headersonly); 335 } 336elsif ($folder->{'type'} == 2) { 337 # POP folder 338 339 # Login first 340 local @rv = &pop3_login($folder); 341 if ($rv[0] != 1) { 342 # Failed to connect or login 343 if ($_[4]) { 344 @{$_[4]} = @rv; 345 return (); 346 } 347 elsif ($rv[0] == 0) { &error($rv[1]); } 348 else { &error(&text('save_elogin', $rv[1])); } 349 } 350 local $h = $rv[1]; 351 local @uidl = &pop3_uidl($h); 352 local %uidlmap; # Map from UIDLs to POP3 indexes 353 for(my $i=0; $i<@uidl; $i++) { 354 $uidlmap{$uidl[$i]} = $i+1; 355 } 356 357 # Work out what we have cached 358 local ($i, $f, %cached, %sizeneed); 359 local $cd = &get_folder_cache_directory($_[2]); 360 if (opendir(CACHE, $cd)) { 361 while($f = readdir(CACHE)) { 362 if ($f =~ /^(\S+)\.body$/) { 363 $cached{$1} = 2; 364 } 365 elsif ($f =~ /^(\S+)\.headers$/) { 366 $cached{$1} = 1; 367 } 368 } 369 closedir(CACHE); 370 } 371 else { 372 mkdir($cd, 0700); 373 } 374 375 # For each requested uidl, get the headers or body 376 foreach my $i (@$ids) { 377 local $u = &safe_uidl($i); 378 print DEBUG "need uidl $i -> $uidlmap{$i}\n"; 379 if ($cached{$u} == 2 || $cached{$u} == 1 && $headersonly) { 380 # We already have everything that we need 381 } 382 elsif ($cached{$u} == 1 || !$headersonly) { 383 # We need to get the entire mail 384 &pop3_command($h, "retr ".$uidlmap{$i}); 385 open(CACHE, ">", "$cd/$u.body"); 386 while(<$h>) { 387 s/\r//g; 388 last if ($_ eq ".\n"); 389 print CACHE $_; 390 } 391 close(CACHE); 392 unlink("$cd/$u.headers"); 393 $cached{$u} = 2; 394 } 395 else { 396 # We just need the headers 397 &pop3_command($h, "top ".$uidlmap{$i}." 0"); 398 open(CACHE, ">", "$cd/$u.headers"); 399 while(<$h>) { 400 s/\r//g; 401 last if ($_ eq ".\n"); 402 print CACHE $_; 403 } 404 close(CACHE); 405 $cached{$u} = 1; 406 } 407 local $mail = &read_mail_file($cached{$u} == 2 ? 408 "$cd/$u.body" : "$cd/$u.headers"); 409 if ($cached{$u} == 1) { 410 if ($mail->{'body'} ne "") { 411 $mail->{'size'} = length($mail->{'body'}); 412 } 413 else { 414 $sizeneed{$uidlmap{$i}} = $mail; 415 } 416 } 417 $mail->{'idx'} = $uidlmap{$i}-1; 418 $mail->{'id'} = $i; 419 push(@mail, $mail); 420 } 421 422 # Get sizes for mails if needed 423 if (%sizeneed) { 424 &pop3_command($h, "list"); 425 while(<$h>) { 426 s/\r//g; 427 last if ($_ eq ".\n"); 428 if (/^(\d+)\s+(\d+)/ && $sizeneed{$1}) { 429 # Find mail in results, and set its size 430 local ($ns) = $sizeneed{$1}; 431 $ns->{'size'} = $2; 432 local $u = &safe_uidl($uidl[$1-1]); 433 open(CACHE, ">>", "$cd/$u.headers"); 434 print CACHE $2,"\n"; 435 close(CACHE); 436 } 437 } 438 } 439 } 440elsif ($folder->{'type'} == 4) { 441 # IMAP folder 442 443 # Login and select the specified mailbox 444 local @irv = &imap_login($folder); 445 if ($irv[0] != 1) { 446 # Something went wrong 447 if ($_[4]) { 448 @{$_[4]} = @irv; 449 return (); 450 } 451 elsif ($irv[0] == 0) { &error($irv[1]); } 452 elsif ($irv[0] == 3) { &error(&text('save_emailbox', $irv[1]));} 453 elsif ($irv[0] == 2) { &error(&text('save_elogin2', $irv[1])); } 454 } 455 local $h = $irv[1]; 456 local $count = $irv[2]; 457 return () if (!$count); 458 $folder->{'lastchange'} = $irv[3] if ($irv[3]); 459 460 # Build map from IDs to original order, as UID FETCH doesn't return 461 # mail in the order we asked for! 462 local %wantpos; 463 for(my $i=0; $i<@$ids; $i++) { 464 $wantpos{$ids->[$i]} = $i; 465 } 466 467 # Fetch each mail by ID. This is done in blocks of 1000, to avoid 468 # hitting a the IMAP server's max request limit 469 @mail = map { undef } @$ids; 470 local $wanted = $headersonly ? "(RFC822.SIZE UID FLAGS RFC822.HEADER)" 471 : "(UID FLAGS BODY.PEEK[])"; 472 if (@$ids) { 473 for(my $chunk=0; $chunk<@$ids; $chunk+=1000) { 474 local $chunkend = $chunk+999; 475 if ($chunkend >= @$ids) { $chunkend = @$ids-1; } 476 local @cids = @$ids[$chunk .. $chunkend]; 477 local @idxrv = &imap_command($h, 478 "UID FETCH ".join(",", @cids)." $wanted"); 479 foreach my $idxrv (@{idxrv->[1]}) { 480 local $mail = &parse_imap_mail($idxrv); 481 if ($mail) { 482 $mail->{'idx'} = $mail->{'imapidx'}-1; 483 $mail[$wantpos{$mail->{'id'}}] = $mail; 484 } 485 } 486 } 487 } 488 print DEBUG "imap rv = ",scalar(@mail),"\n"; 489 } 490elsif ($folder->{'type'} == 5 || $folder->{'type'} == 6) { 491 # Virtual or composite folder .. for each ID, work out the folder and 492 # build a map from folders to ID lists 493 print DEBUG "selecting ",scalar(@$ids)," ids\n"; 494 495 # Build a map from sub-folder names to IDs in them 496 my $i = 0; 497 my %wantmap; 498 foreach my $id (@$ids) { 499 local ($sfn, $sid) = split(/\t+/, $id, 2); 500 push(@{$wantmap{$sfn}}, [ $sid, $i ]); 501 $i++; 502 } 503 504 # Build map from sub-folder names to IDs 505 my (%namemap, @allids, $mems); 506 if ($folder->{'type'} == 6) { 507 # For a virtual folder, we need to find all sub-folders 508 $mems = $folder->{'members'}; 509 foreach my $m (@$mems) { 510 local $sfn = &folder_name($m->[0]); 511 $namemap{$sfn} = $m->[0]; 512 push(@allids, $sfn."\t".$m->[1]); 513 } 514 } 515 else { 516 # For a composite, they are simply listed 517 foreach my $sf (@{$folder->{'subfolders'}}) { 518 local $sfn = &folder_name($sf); 519 $namemap{$sfn} = $sf; 520 } 521 @allids = &mailbox_idlist($folder); 522 } 523 524 # For each sub-folder, get the IDs we need, and put them into the 525 # return array at the right place 526 @mail = map { undef } @$ids; 527 foreach my $sfn (keys %wantmap) { 528 local $sf = $namemap{$sfn}; 529 local @wantids = map { $_->[0] } @{$wantmap{$sfn}}; 530 local @wantidxs = map { $_->[1] } @{$wantmap{$sfn}}; 531 local @sfmail = &mailbox_select_mails($sf, \@wantids, 532 $headersonly); 533 for(my $i=0; $i<@sfmail; $i++) { 534 $mail[$wantidxs[$i]] = $sfmail[$i]; 535 if ($sfmail[$i]) { 536 # Original mail exists .. add to results 537 $sfmail[$i]->{'id'} = 538 $sfn."\t".$sfmail[$i]->{'id'}; 539 $sfmail[$i]->{'idx'} = &indexof( 540 $sfmail[$i]->{'id'}, @allids); 541 print DEBUG "looking for ",$sfmail[$i]->{'id'}," found at ",$sfmail[$i]->{'idx'},"\n"; 542 } 543 else { 544 # Take out of virtual folder index 545 print DEBUG "underlying email $sfn $wantids[$i] is gone!\n"; 546 $mems = [ grep { $_->[0] ne $sf || 547 $_->[1] ne $wantids[$i] } @$mems ]; 548 $changed = 1; 549 } 550 } 551 } 552 if ($changed && $folder->{'type'} == 6) { 553 # Need to save virtual folder 554 $folder->{'members'} = $mems; 555 &save_folder($folder, $folder); 556 } 557 } 558elsif ($folder->{'type'} == 7) { 559 # MBX folder 560 @mail = &select_mbxfile($folder->{'file'}, $ids, $headersonly); 561 } 562&switch_from_folder_user($_[0]); 563return @mail; 564} 565 566# mailbox_get_mail(&folder, id, headersonly) 567# Convenience function to get a single mail by ID 568sub mailbox_get_mail 569{ 570local ($folder, $id, $headersonly) = @_; 571local ($mail) = &mailbox_select_mails($folder, [ $id ], $headersonly); 572if ($mail) { 573 # Find the sort index for this message 574 local ($field, $dir) = &get_sort_field($folder); 575 if (!$field || !$folder->{'sortable'}) { 576 # No sorting, so sort index is the opposite of real 577 $mail->{'sortidx'} = &mailbox_folder_size($folder, 1) - 578 $mail->{'idx'} - 1; 579 print DEBUG "idx=$mail->{'idx'} sortidx=$mail->{'sortidx'} size=",&mailbox_folder_size($folder, 1),"\n"; 580 } 581 else { 582 # Need to extract from sort index 583 local @sorter = &build_sorted_ids($folder, $field, $dir); 584 $mail->{'sortidx'} = &indexof($id, @sorter); 585 } 586 } 587return $mail; 588} 589 590# mailbox_idlist(&folder) 591# Returns a list of IDs of messages in some folder 592sub mailbox_idlist 593{ 594local ($folder) = @_; 595&switch_to_folder_user($_[0]); 596my @idlist; 597if ($folder->{'type'} == 0) { 598 # mbox, for which IDs are mail positions 599 print DEBUG "starting to get IDs from $folder->{'file'}\n"; 600 @idlist = &idlist_mails($folder->{'file'}); 601 print DEBUG "got ",scalar(@idlist)," ids\n"; 602 } 603elsif ($folder->{'type'} == 1) { 604 # maildir, for which IDs are filenames 605 @idlist = &idlist_maildir($folder->{'file'}); 606 } 607elsif ($folder->{'type'} == 2) { 608 # pop3, for which IDs are uidls 609 local @rv = &pop3_login($folder); 610 if ($rv[0] != 1) { 611 # Failed to connect or login 612 if ($rv[0] == 0) { &error($rv[1]); } 613 else { &error(&text('save_elogin', $rv[1])); } 614 } 615 local $h = $rv[1]; 616 @idlist = &pop3_uidl($h); 617 } 618elsif ($folder->{'type'} == 3) { 619 # MH directory, for which IDs are file numbers 620 @idlist = &idlist_mhdir($folder->{'file'}); 621 } 622elsif ($folder->{'type'} == 4) { 623 # IMAP, for which IDs are IMAP UIDs 624 local @rv = &imap_login($folder); 625 if ($rv[0] != 1) { 626 # Something went wrong 627 if ($rv[0] == 0) { &error($rv[1]); } 628 elsif ($rv[0] == 3) { &error(&text('save_emailbox', $rv[1])); } 629 elsif ($rv[0] == 2) { &error(&text('save_elogin2', $rv[1])); } 630 } 631 local $h = $rv[1]; 632 local $count = $rv[2]; 633 return () if (!$count); 634 $folder->{'lastchange'} = $irv[3] if ($irv[3]); 635 636 @rv = &imap_command($h, "FETCH 1:$count UID"); 637 foreach my $uid (@{$rv[1]}) { 638 if ($uid =~ /UID\s+(\d+)/) { 639 push(@idlist, $1); 640 } 641 } 642 } 643elsif ($folder->{'type'} == 5) { 644 # Composite, IDs come from sub-folders 645 foreach my $sf (@{$folder->{'subfolders'}}) { 646 local $sfn = &folder_name($sf); 647 push(@idlist, map { $sfn."\t".$_ } &mailbox_idlist($sf)); 648 } 649 } 650elsif ($folder->{'type'} == 6) { 651 # Virtual, IDs come from sub-folders (where they exist) 652 my (%wantmap, %namemap); 653 foreach my $m (@{$folder->{'members'}}) { 654 local $sf = $m->[0]; 655 local $sid = $m->[1]; 656 local $sfn = &folder_name($sf); 657 push(@{$wantmap{$sfn}}, $sid); 658 $namemap{$sfn} = $sf; 659 } 660 foreach my $sfn (keys %wantmap) { 661 local %wantids = map { $_, 1 } @{$wantmap{$sfn}}; 662 local $sf = $namemap{$sfn}; 663 foreach my $sfid (&mailbox_idlist($sf)) { 664 if ($wantids{$sfid}) { 665 push(@idlist, $sfn."\t".$sfid); 666 } 667 } 668 } 669 } 670&switch_from_folder_user($_[0]); 671return @idlist; 672} 673 674# compute_start_end(start, end, count) 675# Given start and end indexes (which may be negative or undef), returns the 676# real mail file indexes. 677sub compute_start_end 678{ 679local ($start, $end, $count) = @_; 680if (!defined($start)) { 681 return (0, $count-1); 682 } 683elsif ($end < 0) { 684 local $rstart = $count+$_[1]-1; 685 local $rend = $count+$_[0]-1; 686 $rstart = $rstart < 0 ? 0 : $rstart; 687 $rend = $count - 1 if ($rend >= $count); 688 return ($rstart, $rend); 689 } 690else { 691 local $rend = $_[1]; 692 $rend = $count - 1 if ($rend >= $count); 693 return ($start, $rend); 694 } 695} 696 697# mailbox_list_mails_sorted(start, end, &folder, [headeronly], [&error], 698# [sort-field, sort-dir]) 699# Returns messages in a folder within the given range, but sorted by the 700# given field and condition. 701sub mailbox_list_mails_sorted 702{ 703local ($start, $end, $folder, $headersonly, $error, $field, $dir) = @_; 704print DEBUG "mailbox_list_mails_sorted from $start to $end\n"; 705if (!$field) { 706 # Default to current ordering 707 ($field, $dir) = &get_sort_field($folder); 708 } 709if (!$field || !$folder->{'sortable'}) { 710 # No sorting .. just return newest first 711 local @rv = reverse(&mailbox_list_mails( 712 -$start, -$end-1, $folder, $headersonly, $error)); 713 local $i = 0; 714 foreach my $m (@rv) { 715 $m->{'sortidx'} = $i++; 716 } 717 return @rv; 718 } 719 720# For IMAP, login first so that the lastchange can be found 721if ($folder->{'type'} == 4 && !$folder->{'lastchange'}) { 722 &mailbox_select_mails($folder, [ ], 1); 723 } 724 725# Get a sorted list of IDs, and then find the real emails within the range 726local @sorter = &build_sorted_ids($folder, $field, $dir); 727($start, $end) = &compute_start_end($start, $end, scalar(@sorter)); 728print DEBUG "for ",&folder_name($folder)," sorter = ",scalar(@sorter),"\n"; 729print DEBUG "start = $start end = $end\n"; 730local @rv = map { undef } (0 .. scalar(@sorter)-1); 731local @wantids = map { $sorter[$_] } ($start .. $end); 732print DEBUG "wantids = ",scalar(@wantids),"\n"; 733local @mails = &mailbox_select_mails($folder, \@wantids, $headersonly); 734for(my $i=0; $i<@mails; $i++) { 735 $rv[$start+$i] = $mails[$i]; 736 print DEBUG "setting $start+$i to ",$mails[$i]," id ",$wantids[$i],"\n"; 737 $mails[$i]->{'sortidx'} = $start+$i; 738 } 739print DEBUG "rv = ",scalar(@rv),"\n"; 740return @rv; 741} 742 743# build_sorted_ids(&folder, field, dir) 744# Returns a list of message IDs in some folder, sorted on some field 745sub build_sorted_ids 746{ 747local ($folder, $field, $dir) = @_; 748 749# Delete old sort indexes 750&delete_old_sort_index($folder); 751 752# Build or update the sort index. This is a file mapping unique IDs and fields 753# to sortable values. 754local %index; 755&build_new_sort_index($folder, $field, \%index); 756 757# Get message indexes, sorted by the field 758my @sorter; 759while(my ($k, $v) = each %index) { 760 if ($k =~ /^(.*)_\Q$field\E$/) { 761 push(@sorter, [ $1, lc($v) ]); 762 } 763 } 764if ($field eq "size" || $field eq "date" || $field eq "x-spam-status") { 765 # Numeric sort 766 @sorter = sort { my $s = $a->[1] <=> $b->[1]; $dir ? $s : -$s } @sorter; 767 } 768else { 769 # Alpha sort 770 @sorter = sort { my $s = $a->[1] cmp $b->[1]; $dir ? $s : -$s } @sorter; 771 } 772return map { $_->[0] } @sorter; 773} 774 775# delete_old_sort_index(&folder) 776# Delete old index DBM files 777sub delete_old_sort_index 778{ 779local ($folder) = @_; 780local $ifile = &folder_sort_index_file($folder); 781$ifile =~ /^(.*)\/([^\/]+)$/; 782local ($idir, $iname) = ($1, $2); 783opendir(IDIR, $idir); 784foreach my $f (readdir(IDIR)) { 785 if ($f eq $iname || $f =~ /^\Q$iname\E\.[^\.]+$/) { 786 unlink("$idir/$f"); 787 } 788 } 789closedir(IDIR); 790} 791 792# build_new_sort_index(&folder, field, &index) 793# Builds and/or loads the index for sorting a folder on some field. The 794# index uses the mail number as the key, and the field value as the value. 795sub build_new_sort_index 796{ 797local ($folder, $field, $index) = @_; 798return 0 if (!$folder->{'sortable'}); 799local $ifile = &folder_new_sort_index_file($folder); 800 801&open_dbm_db($index, $ifile, 0600); 802print DEBUG "indexchange=$index->{'lastchange'} folderchange=$folder->{'lastchange'}\n"; 803if ($index->{'lastchange'} != $folder->{'lastchange'} || 804 !$folder->{'lastchange'}) { 805 # The mail file has changed .. get IDs and update the index with any 806 # that are missing 807 local @ids = &mailbox_idlist($folder); 808 809 # Find IDs that are new 810 local @newids; 811 foreach my $id (@ids) { 812 if (!defined($index->{$id."_size"})) { 813 push(@newids, $id); 814 } 815 } 816 local @mails = scalar(@newids) ? 817 &mailbox_select_mails($folder, \@newids, 1) : ( ); 818 foreach my $mail (@mails) { 819 foreach my $f (@index_fields) { 820 if ($f eq "date") { 821 # Convert date to Unix time 822 $index->{$mail->{'id'}."_date"} = 823 &parse_mail_date($mail->{'header'}->{'date'}); 824 } 825 elsif ($f eq "size") { 826 # Get mail size 827 $index->{$mail->{'id'}."_size"} = 828 $mail->{'size'}; 829 } 830 elsif ($f eq "from" || $f eq "to") { 831 # From: header .. convert to display version 832 $index->{$mail->{'id'}."_".$f} = 833 &simplify_from($mail->{'header'}->{$f}); 834 } 835 elsif ($f eq "subject") { 836 # Convert subject to display version 837 $index->{$mail->{'id'}."_".$f} = 838 &simplify_subject($mail->{'header'}->{$f}); 839 } 840 elsif ($f eq "x-spam-status") { 841 # Extract spam score 842 $index->{$mail->{'id'}."_".$f} = 843 $mail->{'header'}->{$f} =~ /(hits|score)=([0-9\.]+)/ ? $2 : undef; 844 } 845 else { 846 # Just a header 847 $index->{$mail->{'id'}."_".$f} = 848 $mail->{'header'}->{$f}; 849 } 850 } 851 } 852 print DEBUG "added ",scalar(@mails)," messages to index\n"; 853 854 # Remove IDs that no longer exist 855 local %ids = map { $_, 1 } (@ids, @wantids); 856 local $dc = 0; 857 local @todelete; 858 while(my ($k, $v) = each %$index) { 859 if ($k =~ /^(.*)_([^_]+)$/ && !$ids{$1}) { 860 push(@todelete, $k); 861 $dc++ if ($2 eq "size"); 862 } 863 } 864 foreach my $k (@todelete) { 865 delete($index->{$k}); 866 } 867 print DEBUG "deleted $dc messages from index\n"; 868 869 # Record index update time 870 $index->{'lastchange'} = $folder->{'lastchange'} || time(); 871 $index->{'mailcount'} = scalar(@ids); 872 print DEBUG "new indexchange=$index->{'lastchange'}\n"; 873 } 874return 1; 875} 876 877# delete_new_sort_index_message(&folder, id) 878# Removes a message ID from a sort index 879sub delete_new_sort_index_message 880{ 881local ($folder, $id) = @_; 882local %index; 883&build_new_sort_index($folder, undef, \%index); 884foreach my $field (@index_fields) { 885 delete($index{$id."_".$field}); 886 } 887dbmclose(%index); 888if ($folder->{'type'} == 5 || $folder->{'type'} == 6) { 889 # Remove from underlying folder's index too 890 local ($sfn, $sid) = split(/\t+/, $id, 2); 891 local $sf = &find_subfolder($folder, $sfn); 892 if ($sf) { 893 &delete_new_sort_index_message($sf, $sid); 894 } 895 } 896} 897 898# force_new_index_recheck(&folder) 899# Resets the last-updated time on a folder's index, to force a re-check 900sub force_new_index_recheck 901{ 902local ($folder) = @_; 903local %index; 904&build_new_sort_index($folder, undef, \%index); 905$index{'lastchange'} = 0; 906dbmclose(%index); 907} 908 909# delete_new_sort_index(&folder) 910# Trashes the sort index for a folder, to force a rebuild 911sub delete_new_sort_index 912{ 913local ($folder) = @_; 914local $ifile = &folder_new_sort_index_file($folder); 915 916my %index; 917&open_dbm_db(\%index, $ifile, 0600); 918%index = ( ); 919} 920 921# folder_sort_index_file(&folder) 922# Returns the index file to use for some folder 923sub folder_sort_index_file 924{ 925local ($folder) = @_; 926return &user_index_file(($folder->{'file'} || $folder->{'id'}).".sort"); 927} 928 929# folder_new_sort_index_file(&folder) 930# Returns the new ID-style index file to use for some folder 931sub folder_new_sort_index_file 932{ 933local ($folder) = @_; 934return &user_index_file(($folder->{'file'} || $folder->{'id'}).".byid"); 935} 936 937# mailbox_search_mail(&fields, andmode, &folder, [&limit], [headersonly]) 938# Search a mailbox for multiple matching fields 939sub mailbox_search_mail 940{ 941local ($fields, $andmode, $folder, $limit, $headersonly) = @_; 942 943# For folders other than IMAP and composite and mbox where we already have 944# an index, build a sort index and use that for 945# the search, if it is simple enough (Subject, From and To only) 946local @idxfields = grep { $_->[0] eq 'from' || $_->[0] eq 'to' || 947 $_->[0] eq 'subject' } @{$_[0]}; 948if ($folder->{'type'} != 4 && 949 $folder->{'type'} != 5 && 950 $folder->{'type'} != 6 && 951 ($folder->{'type'} != 0 || !&has_dbm_index($folder->{'file'})) && 952 scalar(@idxfields) == scalar(@$fields) && @idxfields && 953 &get_product_name() eq 'usermin') { 954 print DEBUG "using index to search\n"; 955 local %index; 956 &build_new_sort_index($folder, undef, \%index); 957 local @rv; 958 959 # Work out which mail IDs match the requested headers 960 local %idxmatches = map { ("$_->[0]/$_->[1]", [ ]) } @idxfields; 961 while(my ($k, $v) = each %index) { 962 $k =~ /^(.+)_(\S+)$/ || next; 963 local ($ki, $kf) = ($1, $2); 964 next if (!$kf || $ki eq ''); 965 966 # Check all of the fields to see which ones match 967 foreach my $if (@idxfields) { 968 local $iff = $if->[0]; 969 local ($neg) = ($iff =~ s/^\!//); 970 next if ($kf ne $iff); 971 local $re = $if->[2] ? $if->[1] : "\Q$if->[1]\E"; 972 if (!$neg && $v =~ /$re/i || 973 $neg && $v !~ /$re/i) { 974 push(@{$idxmatches{"$if->[0]/$if->[1]"}}, $ki); 975 } 976 } 977 } 978 local @matches; 979 if ($_[1]) { 980 # Find indexes in all arrays 981 local %icount; 982 foreach my $if (keys %idxmatches) { 983 foreach my $i (@{$idxmatches{$if}}) { 984 $icount{$i}++; 985 } 986 } 987 foreach my $i (keys %icount) { 988 } 989 local $fif = $idxfields[0]; 990 @matches = grep { $icount{$_} == scalar(@idxfields) } 991 @{$idxmatches{"$fif->[0]/$fif->[1]"}}; 992 } 993 else { 994 # Find indexes in any array 995 foreach my $if (keys %idxmatches) { 996 push(@matches, @{$idxmatches{$if}}); 997 } 998 @matches = &unique(@matches); 999 } 1000 @matches = sort { $a cmp $b } @matches; 1001 print DEBUG "matches = ",join(" ", @matches),"\n"; 1002 1003 # Select the actual mails 1004 return &mailbox_select_mails($_[2], \@matches, $headersonly); 1005 } 1006 1007if ($folder->{'type'} == 0) { 1008 # Just search an mbox format file (which will use its own special 1009 # field-level index) 1010 return &advanced_search_mail($folder->{'file'}, $fields, 1011 $andmode, $limit, $headersonly); 1012 } 1013elsif ($folder->{'type'} == 1) { 1014 # Search a maildir directory 1015 return &advanced_search_maildir($folder->{'file'}, $fields, 1016 $andmode, $limit, $headersonly); 1017 } 1018elsif ($folder->{'type'} == 2) { 1019 # Get all of the mail from the POP3 server and search it 1020 local ($min, $max); 1021 if ($limit && $limit->{'latest'}) { 1022 $min = -1; 1023 $max = -$limit->{'latest'}; 1024 } 1025 local @mails = &mailbox_list_mails($min, $max, $folder, 1026 &indexof('body', &search_fields($fields)) < 0 && 1027 $headersonly); 1028 local @rv = grep { $_ && &mail_matches($fields, $andmode, $_) } @mails; 1029 } 1030elsif ($folder->{'type'} == 3) { 1031 # Search an MH directory 1032 return &advanced_search_mhdir($folder->{'file'}, $fields, 1033 $andmode, $limit, $headersonly); 1034 } 1035elsif ($folder->{'type'} == 4) { 1036 # Use IMAP's remote search feature 1037 local @rv = &imap_login($_[2]); 1038 if ($rv[0] == 0) { &error($rv[1]); } 1039 elsif ($rv[0] == 3) { &error(&text('save_emailbox', $rv[1])); } 1040 elsif ($rv[0] == 2) { &error(&text('save_elogin2', $rv[1])); } 1041 local $h = $rv[1]; 1042 $_[2]->{'lastchange'} = $rv[3] if ($rv[3]); 1043 1044 # Do the search to get back a list of matching numbers 1045 local @search; 1046 foreach $f (@{$_[0]}) { 1047 local $field = $f->[0] eq "date" ? "on" : 1048 $f->[0] eq "all" ? "body" : $f->[0]; 1049 local $neg = ($field =~ s/^\!//); 1050 local $what = $f->[1]; 1051 if ($field ne "size") { 1052 $what = "\"".$what."\"" 1053 } 1054 $field = "LARGER" if ($field eq "size"); 1055 local $search; 1056 if ($field =~ /^X-/i) { 1057 $search = "header ".uc($field)." ".$what.""; 1058 } 1059 else { 1060 $search = uc($field)." ".$what.""; 1061 } 1062 $search = "NOT $search" if ($neg); 1063 push(@searches, $search); 1064 } 1065 local $searches; 1066 if (@searches == 1) { 1067 $searches = $searches[0]; 1068 } 1069 elsif ($_[1]) { 1070 $searches = join(" ", @searches); 1071 } 1072 else { 1073 $searches = $searches[$#searches]; 1074 for($i=$#searches-1; $i>=0; $i--) { 1075 $searches = "or $searches[$i] ($searches)"; 1076 } 1077 } 1078 @rv = &imap_command($h, "UID SEARCH $searches"); 1079 &error(&text('save_esearch', $rv[3])) if (!$rv[0]); 1080 1081 # Get back the IDs we want 1082 local ($srch) = grep { $_ =~ /^\*\s+SEARCH/i } @{$rv[1]}; 1083 local @ids = split(/\s+/, $srch); 1084 shift(@ids); shift(@ids); # lose * SEARCH 1085 1086 # Call the select function to get the mails 1087 return &mailbox_select_mails($folder, \@ids, $headersonly); 1088 } 1089elsif ($folder->{'type'} == 5) { 1090 # Search each sub-folder and combine the results - taking any count 1091 # limits into effect 1092 local $sf; 1093 local $pos = 0; 1094 local @mail; 1095 local (%start, %len); 1096 foreach $sf (@{$folder->{'subfolders'}}) { 1097 $len{$sf} = &mailbox_folder_size($sf); 1098 $start{$sf} = $pos; 1099 $pos += $len{$sf}; 1100 } 1101 local $limit = $limit ? { %$limit } : undef; 1102 $limit = undef; 1103 foreach $sf (reverse(@{$folder->{'subfolders'}})) { 1104 local $sfn = &folder_name($sf); 1105 print DEBUG "searching on sub-folder ",&folder_name($sf),"\n"; 1106 local @submail = &mailbox_search_mail($fields, $andmode, $sf, 1107 $limit, $headersonly); 1108 print DEBUG "found ",scalar(@submail),"\n"; 1109 foreach my $sm (@submail) { 1110 $sm->{'id'} = $sfn."\t".$sm->{'id'}; 1111 } 1112 push(@mail, reverse(@submail)); 1113 if ($limit && $limit->{'latest'}) { 1114 # Adjust latest down by size of this folder 1115 $limit->{'latest'} -= $len{$sf}; 1116 last if ($limit->{'latest'} <= 0); 1117 } 1118 } 1119 return reverse(@mail); 1120 } 1121elsif ($folder->{'type'} == 6) { 1122 # Just run a search on the sub-mails 1123 local @rv; 1124 local ($min, $max); 1125 if ($limit && $limit->{'latest'}) { 1126 $min = -1; 1127 $max = -$limit->{'latest'}; 1128 } 1129 local $mail; 1130 local $sfn = &folder_name($sf); 1131 print DEBUG "searching virtual folder ",&folder_name($folder),"\n"; 1132 foreach $mail (&mailbox_list_mails($min, $max, $folder)) { 1133 if ($mail && &mail_matches($fields, $andmode, $mail)) { 1134 push(@rv, $mail); 1135 } 1136 } 1137 return @rv; 1138 } 1139} 1140 1141# mailbox_delete_mail(&folder, mail, ...) 1142# Delete multiple messages from some folder 1143sub mailbox_delete_mail 1144{ 1145return undef if (&is_readonly_mode()); 1146local $f = shift(@_); 1147&switch_to_folder_user($f); 1148if ($userconfig{'delete_mode'} == 1 && !$f->{'trash'} && !$f->{'spam'} && 1149 !$f->{'notrash'}) { 1150 # Copy to trash folder first .. if we have one 1151 local ($trash) = grep { $_->{'trash'} } &list_folders(); 1152 if ($trash) { 1153 my $r; 1154 my $save_read = &get_product_name() eq "usermin"; 1155 foreach my $m (@_) { 1156 $r = &get_mail_read($f, $m) if ($save_read); 1157 my $mcopy = { %$m }; # Because writing changes id 1158 &write_mail_folder($mcopy, $trash); 1159 &set_mail_read($trash, $mcopy, $r) if ($save_read); 1160 } 1161 } 1162 } 1163 1164if ($f->{'type'} == 0) { 1165 # Delete from mbox 1166 &delete_mail($f->{'file'}, @_); 1167 } 1168elsif ($f->{'type'} == 1) { 1169 # Delete from Maildir 1170 &delete_maildir(@_); 1171 } 1172elsif ($f->{'type'} == 2) { 1173 # Login and delete from the POP3 server 1174 local @rv = &pop3_login($f); 1175 if ($rv[0] == 0) { &error($rv[1]); } 1176 elsif ($rv[0] == 2) { &error(&text('save_elogin', $rv[1])); } 1177 local $h = $rv[1]; 1178 local @uidl = &pop3_uidl($h); 1179 local $m; 1180 local $cd = &get_folder_cache_directory($f); 1181 foreach $m (@_) { 1182 local $idx = &indexof($m->{'id'}, @uidl); 1183 if ($idx >= 0) { 1184 &pop3_command($h, "dele ".($idx+1)); 1185 local $u = &safe_uidl($m->{'id'}); 1186 unlink("$cd/$u.headers", "$cd/$u.body"); 1187 } 1188 } 1189 } 1190elsif ($f->{'type'} == 3) { 1191 # Delete from MH dir 1192 &delete_mhdir(@_); 1193 } 1194elsif ($f->{'type'} == 4) { 1195 # Delete from the IMAP server 1196 local @rv = &imap_login($f); 1197 if ($rv[0] == 0) { &error($rv[1]); } 1198 elsif ($rv[0] == 3) { &error(&text('save_emailbox', $rv[1])); } 1199 elsif ($rv[0] == 2) { &error(&text('save_elogin2', $rv[1])); } 1200 local $h = $rv[1]; 1201 1202 local $m; 1203 foreach $m (@_) { 1204 @rv = &imap_command($h, "UID STORE ".$m->{'id'}. 1205 " +FLAGS (\\Deleted)"); 1206 &error(&text('save_edelete', $rv[3])) if (!$rv[0]); 1207 } 1208 @rv = &imap_command($h, "EXPUNGE"); 1209 &error(&text('save_edelete', $rv[3])) if (!$rv[0]); 1210 } 1211elsif ($f->{'type'} == 5 || $f->{'type'} == 6) { 1212 # Delete from underlying folder(s), and from virtual index 1213 foreach my $sm (@_) { 1214 local ($sfn, $sid) = split(/\t+/, $sm->{'id'}, 2); 1215 local $sf = &find_subfolder($f, $sfn); 1216 $sf || &error("Failed to find sub-folder named $sfn"); 1217 if ($f->{'type'} == 5 || $f->{'type'} == 6 && $f->{'delete'}) { 1218 $sm->{'id'} = $sid; 1219 &mailbox_delete_mail($sf, $sm); 1220 $sm->{'id'} = $sfn."\t".$sm->{'id'}; 1221 } 1222 if ($f->{'type'} == 6) { 1223 $f->{'members'} = [ 1224 grep { $_->[0] ne $sf || 1225 $_->[1] ne $sid } @{$f->{'members'}} ]; 1226 } 1227 } 1228 if ($f->{'type'} == 6) { 1229 # Save new ID list 1230 &save_folder($f, $f); 1231 } 1232 } 1233&switch_from_folder_user($f); 1234 1235# Always force a re-check of the index when deleting, as we may not detect 1236# the change (especially for IMAP, where UIDNEXT may not change). This isn't 1237# needed for Maildir or MH, as indexing is reliable enough 1238if ($f->{'type'} != 1 && $f->{'type'} != 3) { 1239 &force_new_index_recheck($f); 1240 } 1241} 1242 1243# mailbox_empty_folder(&folder) 1244# Remove the entire contents of a mail folder 1245sub mailbox_empty_folder 1246{ 1247return undef if (&is_readonly_mode()); 1248local $f = $_[0]; 1249&switch_to_folder_user($f); 1250if ($f->{'type'} == 0) { 1251 # mbox format mail file 1252 &empty_mail($f->{'file'}); 1253 } 1254elsif ($f->{'type'} == 1) { 1255 # qmail format maildir 1256 &empty_maildir($f->{'file'}); 1257 } 1258elsif ($f->{'type'} == 2) { 1259 # POP3 server .. delete all messages 1260 local @rv = &pop3_login($f); 1261 if ($rv[0] == 0) { &error($rv[1]); } 1262 elsif ($rv[0] == 2) { &error(&text('save_elogin', $rv[1])); } 1263 local $h = $rv[1]; 1264 @rv = &pop3_command($h, "stat"); 1265 $rv[1] =~ /^(\d+)/ || return; 1266 local $count = $1; 1267 local $i; 1268 for($i=1; $i<=$count; $i++) { 1269 &pop3_command($h, "dele ".$i); 1270 } 1271 } 1272elsif ($f->{'type'} == 3) { 1273 # mh format maildir 1274 &empty_mhdir($f->{'file'}); 1275 } 1276elsif ($f->{'type'} == 4) { 1277 # IMAP server .. delete all messages 1278 local @rv = &imap_login($f); 1279 if ($rv[0] == 0) { &error($rv[1]); } 1280 elsif ($rv[0] == 3) { &error(&text('save_emailbox', $rv[1])); } 1281 elsif ($rv[0] == 2) { &error(&text('save_elogin2', $rv[1])); } 1282 local $h = $rv[1]; 1283 local $count = $rv[2]; 1284 local $i; 1285 for($i=1; $i<=$count; $i++) { 1286 @rv = &imap_command($h, "STORE ".$i. 1287 " +FLAGS (\\Deleted)"); 1288 &error(&text('save_edelete', $rv[3])) if (!$rv[0]); 1289 } 1290 @rv = &imap_command($h, "EXPUNGE"); 1291 &error(&text('save_edelete', $rv[3])) if (!$rv[0]); 1292 } 1293elsif ($f->{'type'} == 5) { 1294 # Empty each sub-folder 1295 local $sf; 1296 foreach $sf (@{$f->{'subfolders'}}) { 1297 &mailbox_empty_folder($sf); 1298 } 1299 } 1300elsif ($f->{'type'} == 6) { 1301 if ($folder->{'delete'}) { 1302 # Delete all underlying messages 1303 local @dmails = &mailbox_list_mails(undef, undef, $f, 1); 1304 &mailbox_delete_mail($f, @dmails); 1305 } 1306 else { 1307 # Clear the virtual index 1308 $f->{'members'} = [ ]; 1309 &save_folder($f); 1310 } 1311 } 1312&switch_from_folder_user($f); 1313 1314# Trash the folder index 1315if ($folder->{'sortable'}) { 1316 &delete_new_sort_index($folder); 1317 } 1318} 1319 1320# mailbox_copy_folder(&source, &dest) 1321# Copy all messages from one folder to another. This is done in an optimized 1322# way if possible. 1323sub mailbox_copy_folder 1324{ 1325local ($src, $dest) = @_; 1326if ($src->{'type'} == 0 && $dest->{'type'} == 0) { 1327 # mbox to mbox .. just read and write the files 1328 &switch_to_folder_user($src); 1329 &open_as_mail_user(SOURCE, $src->{'file'}); 1330 &switch_from_folder_user($src); 1331 &switch_to_folder_user($dest); 1332 &open_as_mail_user(DEST, ">>$dest->{'file'}"); 1333 while(read(SOURCE, $buf, 32768) > 0) { 1334 print DEST $buf; 1335 } 1336 close(DEST); 1337 close(SOURCE); 1338 &switch_from_folder_user($dest); 1339 } 1340elsif ($src->{'type'} == 1 && $dest->{'type'} == 1) { 1341 # maildir to maildir .. just copy the files 1342 local @files = &get_maildir_files($src->{'file'}); 1343 foreach my $f (@files) { 1344 local $fn = &unique_maildir_filename($dest); 1345 ©_source_dest_as_mail_user($f, "$dest->{'file'}/$fn"); 1346 } 1347 &mailbox_fix_permissions($dest); 1348 } 1349elsif ($src->{'type'} == 1 && $dest->{'type'} == 0) { 1350 # maildir to mbox .. append all the files 1351 &switch_to_folder_user($dest); 1352 &open_as_mail_user(DEST, ">>$dest->{'file'}"); 1353 &switch_from_folder_user($dest); 1354 local $fromline = &make_from_line("webmin\@example.com")."\n"; 1355 &switch_to_folder_user($src); 1356 local @files = &get_maildir_files($src->{'file'}); 1357 foreach my $f (@files) { 1358 &open_as_mail_user(SOURCE, $f); 1359 print DEST $fromline; 1360 my $bs = &get_buffer_size(); 1361 while(read(SOURCE, $buf, $bs) > 0) { 1362 print DEST $buf; 1363 } 1364 close(SOURCE); 1365 } 1366 close(DEST); 1367 &switch_from_folder_user($src); 1368 } 1369else { 1370 # read in all mail and write out, in 100 message blocks 1371 local $max = &mailbox_folder_size($src); 1372 for(my $s=0; $s<$max; $s+=100) { 1373 local $e = $s+99; 1374 $e = $max-1 if ($e >= $max); 1375 local @mail = &mailbox_list_mails($s, $e, $src); 1376 local @want = @mail[$s..$e]; 1377 &mailbox_copy_mail($src, $dest, @want); 1378 } 1379 } 1380} 1381 1382# mailbox_move_mail(&source, &dest, mail, ...) 1383# Move mail from one folder to another 1384sub mailbox_move_mail 1385{ 1386return undef if (&is_readonly_mode()); 1387local $src = shift(@_); 1388local $dst = shift(@_); 1389local $now = time(); 1390local $hn = &get_system_hostname(); 1391local $fix_index; 1392if (($src->{'type'} == 1 || $src->{'type'} == 3) && $dst->{'type'} == 1) { 1393 # Can just move mail files to Maildir names 1394 if ($src->{'user'} eq $dst->{'user'}) { 1395 &switch_to_folder_user($dst); 1396 } 1397 &create_folder_maildir($dst); 1398 local $dd = $dst->{'file'}; 1399 foreach my $m (@_) { 1400 &rename_as_mail_user($m->{'file'}, "$dd/cur/$now.$$.$hn"); 1401 $now++; 1402 } 1403 &mailbox_fix_permissions($dst); 1404 if ($src->{'user'} eq $dst->{'user'}) { 1405 &switch_from_folder_user($dst); 1406 } 1407 $fix_index = 1; 1408 } 1409elsif (($src->{'type'} == 1 || $src->{'type'} == 3) && $dst->{'type'} == 3) { 1410 # Can move and rename to MH numbering 1411 if ($src->{'user'} eq $dst->{'user'}) { 1412 &switch_to_folder_user($dst); 1413 } 1414 &create_folder_maildir($dst); 1415 local $dd = $dst->{'file'}; 1416 local $num = &max_mhdir($dst->{'file'}) + 1; 1417 foreach my $m (@_) { 1418 &rename_as_mail_user($m->{'file'}, "$dd/$num"); 1419 $num++; 1420 } 1421 &mailbox_fix_permissions($dst); 1422 if ($src->{'user'} eq $dst->{'user'}) { 1423 &switch_from_folder_user($dst); 1424 } 1425 $fix_index = 1; 1426 } 1427else { 1428 # Append to new folder file, or create in folder directory 1429 my @mdel; 1430 my $r; 1431 my $save_read = &get_product_name() eq "usermin"; 1432 &switch_to_folder_user($dst); 1433 &create_folder_maildir($dst); 1434 foreach my $m (@_) { 1435 $r = &get_mail_read($src, $m) if ($save_read); 1436 my $mcopy = { %$m }; 1437 &write_mail_folder($mcopy, $dst); 1438 &set_mail_read($dst, $mcopy, $r) if ($save_read); 1439 push(@mdel, $m); 1440 } 1441 local $src->{'notrash'} = 1; # Prevent saving to trash 1442 &switch_from_folder_user($dst); 1443 &mailbox_delete_mail($src, @mdel); 1444 } 1445} 1446 1447# mailbox_fix_permissions(&folder, [&stat]) 1448# Set the ownership on all files in a folder correctly, either based on its 1449# current stat or a structure passed in. 1450sub mailbox_fix_permissions 1451{ 1452local ($f, $st) = @_; 1453return 0 if ($< != 0); # Only makes sense when running as root 1454return 0 if ($main::mail_open_user); # File ops are already done as the 1455 # correct user 1456$st ||= [ stat($f->{'file'}) ]; 1457if ($f->{'type'} == 0) { 1458 # Set perms on a single file 1459 &set_ownership_permissions($st->[4], $st->[5], $st->[2], $f->{'file'}); 1460 return 1; 1461 } 1462elsif ($f->{'type'} == 1 || $f->{'type'} == 3) { 1463 # Do a whole directory 1464 &execute_command("chown -R $st->[4]:$st->[5] ". 1465 quotemeta($dst->{'file'})); 1466 return 1; 1467 } 1468return 0; 1469} 1470 1471# mailbox_move_folder(&source, &dest) 1472# Moves all mail from one folder to another, possibly converting the type 1473sub mailbox_move_folder 1474{ 1475local ($src, $dst) = @_; 1476return undef if (&is_readonly_mode()); 1477&switch_to_folder_user($dst); 1478if ($src->{'type'} == $dst->{'type'} && !$src->{'remote'}) { 1479 # Can just move the file or dir 1480 local @st = stat($src->{'file'}); 1481 &unlink_file($dst->{'file'}); 1482 &rename_as_mail_user($src->{'file'}, $dst->{'file'}); 1483 if (@st) { 1484 &mailbox_fix_permissions($dst, \@st); 1485 } 1486 } 1487elsif (($src->{'type'} == 1 || $src->{'type'} == 3) && $dst->{'type'} == 0) { 1488 # For Maildir or MH to mbox moves, just append files 1489 local @files = $src->{'type'} == 1 ? &get_maildir_files($src->{'file'}) 1490 : &get_mhdir_files($src->{'file'}); 1491 &open_as_mail_user(DEST, ">>$dst->{'file'}"); 1492 local $fromline = &make_from_line("webmin\@example.com"); 1493 foreach my $f (@files) { 1494 &open_as_mail_user(SOURCE, $f); 1495 print DEST $fromline; 1496 while(read(SOURCE, $buf, 32768) > 0) { 1497 print DEST $buf; 1498 } 1499 close(SOURCE); 1500 &unlink_as_mail_user($f); 1501 } 1502 close(DEST); 1503 } 1504else { 1505 # Need to read in and write out. But do it in 1000-message blocks 1506 local $count = &mailbox_folder_size($src); 1507 local $step = 1000; 1508 for(my $start=0; $start<$count; $start+=$step) { 1509 local $end = $start + $step - 1; 1510 $end = $count-1 if ($end >= $count); 1511 local @mails = &mailbox_list_mails($start, $end, $src); 1512 @mails = @mails[$start..$end]; 1513 &mailbox_copy_mail($src, $dst, @mails); 1514 } 1515 &mailbox_empty_folder($src); 1516 } 1517&switch_from_folder_user($dst); 1518 1519# Delete source folder index 1520if ($src->{'sortable'}) { 1521 &delete_new_sort_index($src); 1522 } 1523} 1524 1525# mailbox_copy_mail(&source, &dest, mail, ...) 1526# Copy mail from one folder to another 1527sub mailbox_copy_mail 1528{ 1529return undef if (&is_readonly_mode()); 1530local $src = shift(@_); 1531local $dst = shift(@_); 1532local $now = time(); 1533if ($src->{'type'} == 6 && $dst->{'type'} == 6) { 1534 # Copying from one virtual folder to another, so just copy the 1535 # reference 1536 foreach my $m (@_) { 1537 push(@{$dst->{'members'}}, [ $m->{'subfolder'}, $m->{'subid'}, 1538 $m->{'header'}->{'message-id'} ]); 1539 } 1540 } 1541elsif ($dst->{'type'} == 6) { 1542 # Add this mail to the index of the virtual folder 1543 foreach my $m (@_) { 1544 push(@{$dst->{'members'}}, [ $src, $m->{'idx'}, 1545 $m->{'header'}->{'message-id'} ]); 1546 } 1547 &save_folder($dst); 1548 } 1549else { 1550 # Just write to destination folder. The read status is preserved, but 1551 # only if in Usermin. 1552 my $r; 1553 my $save_read = &get_product_name() eq "usermin"; 1554 &switch_to_folder_user($dst); 1555 &create_folder_maildir($dst); 1556 foreach my $m (@_) { 1557 $r = &get_mail_read($src, $m) if ($save_read); 1558 my $mcopy = { %$m }; 1559 &write_mail_folder($mcopy, $dst); 1560 &set_mail_read($dst, $mcopy, $r) if ($save_read); 1561 } 1562 &switch_from_folder_user($dst); 1563 } 1564} 1565 1566# folder_type(file_or_dir) 1567# Returns a numeric folder type based on the contents 1568sub folder_type 1569{ 1570my ($f) = @_; 1571if (-d "$f/cur") { 1572 # Maildir directory 1573 return 1; 1574 } 1575elsif (-d $f) { 1576 # MH directory 1577 return 3; 1578 } 1579else { 1580 # Check for MBX format 1581 open(MBXTEST, "<", $f); 1582 my $first; 1583 read(MBXTEST, $first, 5); 1584 close(MBXTEST); 1585 return $first eq "*mbx*" ? 7 : 0; 1586 } 1587} 1588 1589# create_folder_maildir(&folder) 1590# Ensure that a maildir folder has the needed new, cur and tmp directories 1591sub create_folder_maildir 1592{ 1593if ($folders_dir) { 1594 mkdir($folders_dir, 0700); 1595 } 1596if ($_[0]->{'type'} == 1) { 1597 local $id = $_[0]->{'file'}; 1598 &mkdir_as_mail_user($id, 0700); 1599 &mkdir_as_mail_user("$id/cur", 0700); 1600 &mkdir_as_mail_user("$id/new", 0700); 1601 &mkdir_as_mail_user("$id/tmp", 0700); 1602 } 1603} 1604 1605# write_mail_folder(&mail, &folder, textonly) 1606# Writes some mail message to a folder 1607sub write_mail_folder 1608{ 1609return undef if (&is_readonly_mode()); 1610&switch_to_folder_user($_[1]); 1611&create_folder_maildir($_[1]); 1612local $needid; 1613if ($_[1]->{'type'} == 1) { 1614 # Add to a maildir directory. ID is set by write_maildir to the new 1615 # relative filename 1616 local $md = $_[1]->{'file'}; 1617 &write_maildir($_[0], $md, $_[2]); 1618 } 1619elsif ($_[1]->{'type'} == 3) { 1620 # Create a new MH file. ID is just the new message number 1621 local $num = &max_mhdir($_[1]->{'file'}) + 1; 1622 local $md = $_[1]->{'file'}; 1623 local @st = stat($_[1]->{'file'}); 1624 &send_mail($_[0], "$md/$num", $_[2], 1); 1625 if ($< == 0) { 1626 &set_ownership_permissions($st[4], $st[5], undef, "$md/$num"); 1627 } 1628 $_[0]->{'id'} = $num; 1629 } 1630elsif ($_[1]->{'type'} == 0) { 1631 # Just append to the folder file. 1632 &send_mail($_[0], $_[1]->{'file'}, $_[2], 1); 1633 $needid = 1; 1634 } 1635elsif ($_[1]->{'type'} == 4) { 1636 # Upload to the IMAP server 1637 local @rv = &imap_login($_[1]); 1638 if ($rv[0] == 0) { &error($rv[1]); } 1639 elsif ($rv[0] == 3) { &error(&text('save_emailbox', $rv[1])); } 1640 elsif ($rv[0] == 2) { &error(&text('save_elogin2', $rv[1])); } 1641 local $h = $rv[1]; 1642 1643 # Create a temp file and use it to create the IMAP command 1644 local $temp = &transname(); 1645 &send_mail($_[0], $temp, $_[2], 0, "dummy"); 1646 local $text = &read_file_contents($temp); 1647 unlink($temp); 1648 $text =~ s/^From.*\r?\n//; # Not part of IMAP format 1649 @rv = &imap_command($h, sprintf "APPEND \"%s\" {%d}\r\n%s", 1650 $_[1]->{'mailbox'} || "INBOX", length($text), $text); 1651 &error(&text('save_eappend', $rv[3])) if (!$rv[0]); 1652 $needid = 1; 1653 } 1654elsif ($_[1]->{'type'} == 5) { 1655 # Just append to the last subfolder 1656 local @sf = @{$_[1]->{'subfolders'}}; 1657 &write_mail_folder($_[0], $sf[$#sf], $_[2]); 1658 $needid = 1; 1659 } 1660elsif ($_[1]->{'type'} == 6) { 1661 # Add mail to first sub-folder, and to virtual index 1662 # XXX not done 1663 &error("Cannot add mail to virtual folders"); 1664 } 1665&switch_from_folder_user($_[1]); 1666if ($needid) { 1667 # Get the ID of the new mail 1668 local @idlist = &mailbox_idlist($_[1]); 1669 print DEBUG "new idlist=",join(" ", @idlist),"\n"; 1670 $_[0]->{'id'} = $idlist[$#idlist]; 1671 } 1672} 1673 1674# mailbox_modify_mail(&oldmail, &newmail, &folder, textonly) 1675# Replaces some mail message with a new one 1676sub mailbox_modify_mail 1677{ 1678local ($oldmail, $mail, $folder, $textonly) = @_; 1679return undef if (&is_readonly_mode()); 1680&switch_to_folder_user($_[2]); 1681if ($folder->{'type'} == 1) { 1682 # Just replace the existing file 1683 &modify_maildir($oldmail, $mail, $textonly); 1684 } 1685elsif ($folder->{'type'} == 3) { 1686 # Just replace the existing file 1687 &modify_mhdir($oldmail, $mail, $textonly); 1688 } 1689elsif ($folder->{'type'} == 0) { 1690 # Modify the mail file 1691 &modify_mail($folder->{'file'}, $oldmail, $mail, $textonly); 1692 } 1693elsif ($folder->{'type'} == 5 || $folder->{'type'} == 6) { 1694 # Modify in the underlying folder 1695 local ($oldsfn, $oldsid) = split(/\t+/, $oldmail->{'id'}, 2); 1696 local ($sfn, $sid) = split(/\t+/, $mail->{'id'}, 2); 1697 local $sf = &find_subfolder($folder, $sfn); 1698 $oldmail->{'id'} = $oldsid; 1699 $mail->{'id'} = $sid; 1700 &mailbox_modify_mail($oldmail, $mail, $sf, $textonly); 1701 $oldmail->{'id'} = $oldsfn."\t".$oldsid; 1702 $mail->{'id'} = $sfn."\t".$sid; 1703 } 1704else { 1705 &error("Cannot modify mail in this type of folder!"); 1706 } 1707&switch_from_folder_user($_[2]); 1708 1709# Delete the message being modified from its index, to force re-generation 1710# with new details 1711$mail->{'id'} = $oldmail->{'id'}; # Assume that it will replace the old 1712if ($folder->{'sortable'}) { 1713 &delete_new_sort_index_message($folder, $mail->{'id'}); 1714 } 1715} 1716 1717# mailbox_folder_size(&folder, [estimate]) 1718# Returns the number of messages in some folder 1719sub mailbox_folder_size 1720{ 1721local ($f, $est) = @_; 1722&switch_to_folder_user($f); 1723local $rv; 1724if ($f->{'type'} == 0) { 1725 # A mbox formatted file 1726 $rv = &count_mail($f->{'file'}); 1727 } 1728elsif ($f->{'type'} == 1) { 1729 # A qmail maildir 1730 $rv = &count_maildir($f->{'file'}); 1731 } 1732elsif ($f->{'type'} == 2) { 1733 # A POP3 server 1734 local @rv = &pop3_login($f); 1735 if ($rv[0] != 1) { 1736 if ($rv[0] == 0) { &error($rv[1]); } 1737 else { &error(&text('save_elogin', $rv[1])); } 1738 } 1739 local @st = &pop3_command($rv[1], "stat"); 1740 if ($st[0] == 1) { 1741 local ($count, $size) = split(/\s+/, $st[1]); 1742 return $count; 1743 } 1744 else { 1745 &error($st[1]); 1746 } 1747 } 1748elsif ($f->{'type'} == 3) { 1749 # An MH directory 1750 $rv = &count_mhdir($f->{'file'}); 1751 } 1752elsif ($f->{'type'} == 4) { 1753 # An IMAP server 1754 local @rv = &imap_login($f); 1755 if ($rv[0] != 1) { 1756 if ($rv[0] == 0) { &error($rv[1]); } 1757 elsif ($rv[0] == 3) { &error(&text('save_emailbox', $rv[1])); } 1758 elsif ($rv[0] == 2) { &error(&text('save_elogin2', $rv[1])); } 1759 } 1760 $f->{'lastchange'} = $rv[3]; 1761 $rv = $rv[2]; 1762 } 1763elsif ($f->{'type'} == 5) { 1764 # A composite folder - the size is just that of the sub-folders 1765 $rv = 0; 1766 foreach my $sf (@{$f->{'subfolders'}}) { 1767 $rv += &mailbox_folder_size($sf); 1768 } 1769 } 1770elsif ($f->{'type'} == 6 && !$est) { 1771 # A virtual folder .. we need to exclude messages that no longer 1772 # exist in the parent folders 1773 $rv = 0; 1774 foreach my $msg (@{$f->{'members'}}) { 1775 if (&mailbox_get_mail($msg->[0], $msg->[1])) { 1776 $rv++; 1777 } 1778 } 1779 } 1780elsif ($f->{'type'} == 6 && $est) { 1781 # A virtual folder .. but we can just use the last member count 1782 $rv = scalar(@{$f->{'members'}}); 1783 } 1784&switch_from_folder_user($f); 1785return $rv; 1786} 1787 1788# mailbox_folder_unread(&folder) 1789# Returns the total messages in some folder, the number unread and the number 1790# flagged as special. 1791sub mailbox_folder_unread 1792{ 1793local ($folder) = @_; 1794if ($folder->{'type'} == 4) { 1795 # For IMAP, the server knows 1796 local @rv = &imap_login($folder); 1797 if ($rv[0] != 1) { 1798 return ( ); 1799 } 1800 local @data = ( $rv[2] ); 1801 local $h = $rv[1]; 1802 foreach my $s ("UNSEEN", "FLAGGED") { 1803 @rv = &imap_command($h, "SEARCH ".$s); 1804 local ($srch) = grep { $_ =~ /^\*\s+SEARCH/i } @{$rv[1]}; 1805 local @ids = split(/\s+/, $srch); 1806 shift(@ids); shift(@ids); # lose * SEARCH 1807 push(@data, scalar(@ids)); 1808 } 1809 return @data; 1810 } 1811elsif ($folder->{'type'} == 5) { 1812 # Composite folder - counts are sums of sub-folders 1813 local @data; 1814 foreach my $sf (@{$folder->{'subfolders'}}) { 1815 local @sfdata = &mailbox_folder_unread($sf); 1816 if (scalar(@sfdata)) { 1817 $data[0] += $sfdata[0]; 1818 $data[1] += $sfdata[1]; 1819 $data[2] += $sfdata[2]; 1820 } 1821 } 1822 return @data; 1823 } 1824else { 1825 # For all other folders, just check individual messages 1826 # XXX faster for maildir? 1827 local @data = ( 0, 0, 0 ); 1828 local @mails; 1829 eval { 1830 $main::error_must_die = 1; 1831 @mails = &mailbox_list_mails(undef, undef, $folder, 1); 1832 }; 1833 return ( ) if ($@); 1834 foreach my $m (@mails) { 1835 local $rf = &get_mail_read($folder, $m); 1836 if ($rf == 2) { 1837 $data[2]++; 1838 } 1839 elsif ($rf == 0) { 1840 $data[1]++; 1841 } 1842 $data[0]++; 1843 } 1844 return @data; 1845 } 1846} 1847 1848# mailbox_set_read_flags(&folder, &mail, read, special, replied) 1849# Updates the status flags on some message 1850sub mailbox_set_read_flag 1851{ 1852local ($folder, $mail, $read, $special, $replied) = @_; 1853if ($folder->{'type'} == 4) { 1854 # Set flags on IMAP server 1855 local @rv = &imap_login($folder); 1856 if ($rv[0] == 0) { &error($rv[1]); } 1857 elsif ($rv[0] == 3) { &error(&text('save_emailbox', $rv[1])); } 1858 elsif ($rv[0] == 2) { &error(&text('save_elogin2', $rv[1])); } 1859 local $h = $rv[1]; 1860 foreach my $f ([ $read, "\\Seen" ], 1861 [ $special, "\\Flagged" ], 1862 [ $replied, "\\Answered" ]) { 1863 print DEBUG "setting '$f->[0]' '$f->[1]' for $mail->{'id'}\n"; 1864 next if (!defined($f->[0])); 1865 local $pm = $f->[0] ? "+" : "-"; 1866 @rv = &imap_command($h, "UID STORE ".$mail->{'id'}. 1867 " ".$pm."FLAGS (".$f->[1].")"); 1868 &error(&text('save_eflag', $rv[3])) if (!$rv[0]); 1869 } 1870 } 1871elsif ($folder->{'type'} == 1) { 1872 # Add flag to special characters at end of filename 1873 my $file = $mail->{'file'} || $mail->{'id'}; 1874 my $path; 1875 if (!$mail->{'file'}) { 1876 $path = "$folder->{'file'}/"; 1877 } 1878 my ($base, %flags); 1879 if ($file =~ /^(.*):2,([A-Z]*)$/) { 1880 $base = $1; 1881 %flags = map { $_, 1 } split(//, $2); 1882 } 1883 else { 1884 $base = $file; 1885 } 1886 $flags{'S'} = $read; 1887 $flags{'F'} = $special; 1888 $flags{'R'} = $replied if (defined($replied)); 1889 my $newfile = $base.":2,". 1890 join("", grep { $flags{$_} } sort(keys %flags)); 1891 if ($newfile ne $file) { 1892 # Need to rename file 1893 rename("$path$file", "$path$newfile"); 1894 $newfile =~ s/^(.*)\/((cur|tmp|new)\/.*)$/$2/; 1895 $mail->{'id'} = $newfile; 1896 &flush_maildir_cachefile($folder->{'file'}); 1897 } 1898 } 1899else { 1900 &error("Read flags cannot be set on folders of type $folder->{'type'}"); 1901 } 1902 1903# Update the mail object too 1904$mail->{'read'} = $read if (defined($read)); 1905$mail->{'special'} = $special if (defined($special)); 1906$mail->{'replied'} = $replied if (defined($replied)); 1907} 1908 1909# pop3_login(&folder) 1910# Logs into a POP3 server and returns a status (1=ok, 0=connect failed, 1911# 2=login failed) and handle or error message 1912sub pop3_login 1913{ 1914local $h = $pop3_login_handle{$_[0]->{'id'}}; 1915return (1, $h) if ($h); 1916$h = "POP3".time().++$pop3_login_count; 1917local $error; 1918&open_socket($_[0]->{'server'}, $_[0]->{'port'} || 110, $h, \$error); 1919print DEBUG "pop3 open_socket to $_[0]->{'server'} : $error\n"; 1920return (0, $error) if ($error); 1921local $os = select($h); $| = 1; select($os); 1922local @rv = &pop3_command($h); 1923return (0, $rv[1]) if (!$rv[0]); 1924local $user = $_[0]->{'user'} eq '*' ? $remote_user : $_[0]->{'user'}; 1925@rv = &pop3_command($h, "user $user"); 1926return (2, $rv[1]) if (!$rv[0]); 1927@rv = &pop3_command($h, "pass $_[0]->{'pass'}"); 1928return (2, $rv[1]) if (!$rv[0]); 1929return (1, $pop3_login_handle{$_[0]->{'id'}} = $h); 1930} 1931 1932# pop3_command(handle, command) 1933# Executes a command and returns the status (1 or 0 for OK or ERR) and message 1934sub pop3_command 1935{ 1936local ($h, $c) = @_; 1937print $h "$c\r\n" if ($c); 1938local $rv = <$h>; 1939$rv =~ s/\r|\n//g; 1940print DEBUG "pop3 $c -> $rv\n"; 1941return !$rv ? ( 0, "Connection closed" ) : 1942 $rv =~ /^\+OK\s*(.*)/ ? ( 1, $1 ) : 1943 $rv =~ /^\-ERR\s*(.*)/ ? ( 0, $1 ) : ( 0, $rv ); 1944} 1945 1946# pop3_logout(handle, doquit) 1947sub pop3_logout 1948{ 1949local @rv = $_[1] ? &pop3_command($_[0], "quit") : (1, undef); 1950local $f; 1951foreach $f (keys %pop3_login_handle) { 1952 delete($pop3_login_handle{$f}) if ($pop3_login_handle{$f} eq $_[0]); 1953 } 1954close($_[0]); 1955return @rv; 1956} 1957 1958# pop3_uidl(handle) 1959# Returns the uidl list 1960sub pop3_uidl 1961{ 1962local @rv; 1963local $h = $_[0]; 1964local @urv = &pop3_command($h, "uidl"); 1965if (!$urv[0] && $urv[1] =~ /not\s+implemented/i) { 1966 # UIDL is not available?! Use numeric list instead 1967 &pop3_command($h, "list"); 1968 while(<$h>) { 1969 s/\r//g; 1970 last if ($_ eq ".\n"); 1971 if (/^(\d+)\s+(\d+)/) { 1972 push(@rv, "size$2"); 1973 } 1974 } 1975 } 1976elsif (!$urv[0]) { 1977 &error("uidl failed! $urv[1]") if (!$urv[0]); 1978 } 1979else { 1980 # Can get normal UIDL list 1981 while(<$h>) { 1982 s/\r//g; 1983 last if ($_ eq ".\n"); 1984 if (/^(\d+)\s+(\S+)/) { 1985 push(@rv, $2); 1986 } 1987 } 1988 } 1989return @rv; 1990} 1991 1992# pop3_logout_all() 1993# Properly closes all open POP3 and IMAP sessions 1994sub pop3_logout_all 1995{ 1996local $f; 1997foreach $f (keys %pop3_login_handle) { 1998 &pop3_logout($pop3_login_handle{$f}, 1); 1999 } 2000foreach $f (keys %imap_login_handle) { 2001 &imap_logout($imap_login_handle{$f}, 1); 2002 } 2003} 2004 2005# imap_login(&folder) 2006# Logs into a POP3 server, selects a mailbox and returns a status 2007# (1=ok, 0=connect failed, 2=login failed, 3=mailbox error), a handle or error 2008# message, the number of messages in the mailbox, the next UID, the number 2009# unread, and the number special. 2010sub imap_login 2011{ 2012local ($folder) = @_; 2013local $defport = $folder->{'ssl'} ? 993 : 143; 2014local $port = $folder->{'port'} || $defport; 2015local $key = join("/", $folder->{'server'}, $port, $folder->{'user'}); 2016local $h = $imap_login_handle{$key}; 2017local @rv; 2018if (!$h) { 2019 # Need to open socket 2020 $h = ($folder->{'ssl'} ? "SSL" : "")."IMAP".time().++$imap_login_count; 2021 local $error; 2022 print DEBUG "Connecting to IMAP server $folder->{'server'}:$port\n"; 2023 &open_socket($folder->{'server'}, $port, $h, \$error); 2024 print DEBUG "IMAP error=$error\n" if ($error); 2025 return (0, $error) if ($error); 2026 local $os = select($h); $| = 1; select($os); 2027 if ($folder->{'ssl'}) { 2028 # Switch to SSL mode 2029 eval "use Net::SSLeay"; 2030 $@ && return (0, "Net::SSLeay module is not installed"); 2031 eval "Net::SSLeay::SSLeay_add_ssl_algorithms()"; 2032 eval "Net::SSLeay::load_error_strings()"; 2033 my $ssl_ctx = Net::SSLeay::CTX_new() || 2034 return (0, "Failed to create SSL context"); 2035 my $ssl_con = Net::SSLeay::new($ssl_ctx) || 2036 return (0, "Failed to create SSL connection"); 2037 Net::SSLeay::set_fd($ssl_con, fileno($h)); 2038 Net::SSLeay::connect($ssl_con) || 2039 return (0, "SSL connect() failed"); 2040 $imap_login_ssl{$h} = $ssl_con; 2041 } 2042 2043 # Login normally 2044 @rv = &imap_command($h); 2045 return (0, $rv[3] || "No response") if (!$rv[0]); 2046 local $user = $folder->{'user'} eq '*' ? $remote_user 2047 : $folder->{'user'}; 2048 local $pass = $folder->{'pass'}; 2049 $pass =~ s/\\/\\\\/g; 2050 $pass =~ s/"/\\"/g; 2051 @rv = &imap_command($h,"login \"$user\" \"$pass\""); 2052 return (2, $rv[3] || "No response") if (!$rv[0]); 2053 2054 $imap_login_handle{$key} = $h; 2055 } 2056 2057# Select the right folder (if one was given) 2058@rv = &imap_command($h, "select \"".($folder->{'mailbox'} || "INBOX")."\""); 2059return (3, $rv[3]) if (!$rv[0]); 2060local $count = $rv[2] =~ /\*\s+(\d+)\s+EXISTS/i ? $1 : undef; 2061local $uidnext = $rv[2] =~ /UIDNEXT\s+(\d+)/ ? $1 : undef; 2062return (1, $h, $count, $uidnext); 2063} 2064 2065# imap_command(handle, command) 2066# Executes an IMAP command and returns 1 for success or 0 for failure, and 2067# a reference to an array of results (some of which may be multiline), and 2068# all of the results joined together, and the stuff after OK/BAD 2069sub imap_command 2070{ 2071my ($h, $c) = @_; 2072if (!$h) { 2073 my $err = "Invalid IMAP handle"; 2074 return (0, [ $err ], $err, $err); 2075 } 2076my $ssl_con = $imap_login_ssl{$h}; 2077my @rv; 2078 2079# Send the command, and read lines until a non-* one is found 2080my $id = $$."-".$imap_command_count++; 2081my ($first, $rest) = split(/\r?\n/, $c, 2); 2082if ($rest) { 2083 # Multi-line - send first line, then wait for continuation, then rest 2084 print DEBUG "imap command $id $first\n"; 2085 my $l; 2086 if ($ssl_con) { 2087 Net::SSLeay::write($ssl_con, "$id $first\r\n"); 2088 $l = Net::SSLeay::ssl_read_until($ssl_con); 2089 } 2090 else { 2091 print $h "$id $first\r\n"; 2092 $l = <$h>; 2093 } 2094 print DEBUG "imap line $l"; 2095 if ($l =~ /^\+/) { 2096 if ($ssl_con) { 2097 Net::SSLeay::write($ssl_con, $rest."\r\n"); 2098 } 2099 else { 2100 print $h $rest."\r\n"; 2101 } 2102 } 2103 else { 2104 my $err = "Server did not ask for continuation : $l"; 2105 return (0, [ $err ], $err, $err); 2106 } 2107 } 2108elsif ($c) { 2109 # Single line command 2110 if ($ssl_con) { 2111 Net::SSLeay::write($ssl_con, "$id $c\r\n"); 2112 } 2113 else { 2114 print $h "$id $c\r\n"; 2115 } 2116 print DEBUG "imap command $id $c\n"; 2117 } 2118while(1) { 2119 my $l; 2120 if ($ssl_con) { 2121 $l = Net::SSLeay::ssl_read_until($ssl_con); 2122 } 2123 else { 2124 $l = <$h>; 2125 } 2126 print DEBUG "imap line $l"; 2127 last if (!$l); 2128 if ($l =~ /^(\*|\+)/) { 2129 # Another response, and possibly the only one if no command 2130 # was sent. 2131 push(@rv, $l); 2132 last if (!$c); 2133 if ($l =~ /\{(\d+)\}\s*$/) { 2134 # Start of multi-line text .. read the specified size 2135 my $size = $1; 2136 my $got; 2137 my $err = "Error reading email"; 2138 while($got < $size) { 2139 my $buf; 2140 my $r; 2141 if ($ssl_con) { 2142 $buf = Net::SSLeay::read($ssl_con, $size-$got); 2143 $r = length($buf); 2144 } 2145 else { 2146 $r = read($h, $buf, $size-$got); 2147 } 2148 return (0, [ $err ], $err, $err) if ($r <= 0); 2149 $rv[$#rv] .= $buf; 2150 $got += $r; 2151 } 2152 } 2153 } 2154 elsif ($l =~ /^(\S+)\s+/ && $1 eq $id) { 2155 # End of responses 2156 push(@rv, $l); 2157 last; 2158 } 2159 else { 2160 # Part of last response 2161 if (!@rv) { 2162 my $err = "Got unknown line $l"; 2163 return (0, [ $err ], $err, $err); 2164 } 2165 $rv[$#rv] .= $l; 2166 } 2167 } 2168my $j = join("", @rv); 2169print DEBUG "imap response $j\n"; 2170my $lline = $rv[$#rv]; 2171if ($lline =~ /^(\S+)\s+OK\s*(.*)/) { 2172 # Looks like the command worked 2173 return (1, \@rv, $j, $2); 2174 } 2175else { 2176 # Command failed! 2177 return (0, \@rv, $j, $lline =~ /^(\S+)\s+(\S+)\s*(.*)/ ? $3 : $lline); 2178 } 2179} 2180 2181# imap_logout(handle, doquit) 2182sub imap_logout 2183{ 2184local @rv = $_[1] ? &imap_command($_[0], "close") : (1, undef); 2185local $f; 2186foreach $f (keys %imap_login_handle) { 2187 delete($imap_login_handle{$f}) if ($imap_login_handle{$f} eq $_[0]); 2188 } 2189close($_[0]); 2190return @rv; 2191} 2192 2193# lock_folder(&folder) 2194sub lock_folder 2195{ 2196return if ($_[0]->{'remote'} || $_[0]->{'type'} == 5 || $_[0]->{'type'} == 6); 2197local $f = $_[0]->{'file'} ? $_[0]->{'file'} : 2198 $_[0]->{'type'} == 0 ? &user_mail_file($remote_user) : 2199 $qmail_maildir; 2200if (&lock_file($f)) { 2201 $_[0]->{'lock'} = $f; 2202 } 2203else { 2204 # Cannot lock if in /var/mail 2205 local $ff = $f; 2206 $ff =~ s/\//_/g; 2207 $ff = "/tmp/$ff"; 2208 $_[0]->{'lock'} = $ff; 2209 &lock_file($ff); 2210 } 2211 2212# Also, check for a .filename.pop3 file 2213if ($config{'pop_locks'} && $f =~ /^(\S+)\/([^\/]+)$/) { 2214 local $poplf = "$1/.$2.pop"; 2215 local $count = 0; 2216 while(-r $poplf) { 2217 sleep(1); 2218 if ($count++ > 5*60) { 2219 # Give up after 5 minutes 2220 &error(&text('epop3lock_tries', "<tt>$f</tt>", 5)); 2221 } 2222 } 2223 } 2224} 2225 2226# unlock_folder(&folder) 2227sub unlock_folder 2228{ 2229return if ($_[0]->{'remote'}); 2230&unlock_file($_[0]->{'lock'}); 2231} 2232 2233# folder_file(&folder) 2234# Returns the full path to the file or directory containing the folder's mail, 2235# or undef if not appropriate (such as for POP3) 2236sub folder_file 2237{ 2238return $_[0]->{'remote'} ? undef : $_[0]->{'file'}; 2239} 2240 2241# parse_imap_mail(response) 2242# Parses a response from the IMAP server into a standard mail structure 2243sub parse_imap_mail 2244{ 2245local ($imap) = @_; 2246 2247# Extract the actual mail part 2248local $mail = { }; 2249local $realsize; 2250if ($imap =~ /RFC822.SIZE\s+(\d+)/) { 2251 $realsize = $1; 2252 } 2253if ($imap =~ /UID\s+(\d+)/) { 2254 $mail->{'id'} = $1; 2255 } 2256if ($imap =~ /FLAGS\s+\(([^\)]+)\)/ || 2257 $imap =~ /FLAGS\s+(\S+)/) { 2258 # Got read flags .. use them 2259 local @flags = split(/\s+/, $1); 2260 $mail->{'read'} = &indexoflc("\\Seen", @flags) >= 0 ? 1 : 0; 2261 $mail->{'special'} = &indexoflc("\\Flagged", @flags) >= 0 ? 1 : 0; 2262 $mail->{'replied'} = &indexoflc("\\Answered", @flags) >= 0 ? 1 : 0; 2263 $mail->{'deleted'} = &indexoflc("\\Deleted", @flags) >= 0 ? 1 : 0; 2264 } 2265$imap =~ s/^\*\s+(\d+)\s+FETCH.*\{(\d+)\}\r?\n// || return undef; 2266$mail->{'imapidx'} = $1; 2267local $size = $2; 2268local @lines = split(/\n/, substr($imap, 0, $size)); 2269 2270# Parse the headers 2271local $lnum = 0; 2272local @headers; 2273while(1) { 2274 local $line = $lines[$lnum++]; 2275 $mail->{'size'} += length($line); 2276 $line =~ s/\r//g; 2277 last if ($line eq ''); 2278 if ($line =~ /^(\S+):\s*(.*)/) { 2279 push(@headers, [ $1, $2 ]); 2280 } 2281 elsif ($line =~ /^(\s+.*)/) { 2282 $headers[$#headers]->[1] .= $1 2283 unless($#headers < 0); 2284 } 2285 } 2286$mail->{'headers'} = \@headers; 2287foreach $h (@headers) { 2288 $mail->{'header'}->{lc($h->[0])} = $h->[1]; 2289 } 2290 2291# Parse the body 2292while($lnum < @lines) { 2293 $mail->{'size'} += length($lines[$lnum]+1); 2294 $mail->{'body'} .= $lines[$lnum]."\n"; 2295 $lnum++; 2296 } 2297$mail->{'size'} = $realsize if ($realsize); 2298return $mail; 2299} 2300 2301# find_body(&mail, mode) 2302# Returns the plain text body, html body and the one to use 2303sub find_body 2304{ 2305local ($a, $body, $textbody, $htmlbody); 2306foreach $a (@{$_[0]->{'attach'}}) { 2307 next if ($a->{'header'}->{'content-disposition'} =~ /^attachment/i); 2308 if ($a->{'type'} =~ /^text\/plain/i || $a->{'type'} eq 'text') { 2309 $textbody = $a if (!$textbody && $a->{'data'} =~ /\S/); 2310 } 2311 elsif ($a->{'type'} =~ /^text\/html/i) { 2312 $htmlbody = $a if (!$htmlbody && $a->{'data'} =~ /\S/); 2313 } 2314 } 2315if ($_[1] == 0) { 2316 $body = $textbody; 2317 } 2318elsif ($_[1] == 1) { 2319 $body = $textbody || $htmlbody; 2320 } 2321elsif ($_[1] == 2) { 2322 $body = $htmlbody || $textbody; 2323 } 2324elsif ($_[1] == 3) { 2325 # Convert HTML to text if needed 2326 if ($textbody) { 2327 $body = $textbody; 2328 } 2329 elsif ($htmlbody) { 2330 local $text = &html_to_text($htmlbody->{'data'}); 2331 $body = $textbody = 2332 { 'data' => $text }; 2333 } 2334 } 2335return ($textbody, $htmlbody, $body); 2336} 2337 2338# safe_html(html) 2339# Converts HTML to a form safe for inclusion in a page 2340sub safe_html 2341{ 2342local $html = $_[0]; 2343local $bodystuff; 2344if ($html =~ s/^[\000-\377]*?<BODY([^>]*)>//i) { 2345 $bodystuff = $1; 2346 } 2347$html =~ s/<\/BODY>[\000-\377]*$//i; 2348$html =~ s/<base[^>]*>//i; 2349$html = &filter_javascript($html); 2350$html = &safe_urls($html); 2351$bodystuff = &safe_html($bodystuff) if ($bodystuff); 2352return wantarray ? ($html, $bodystuff) : $html; 2353} 2354 2355# head_html(html) 2356# Returns HTML in the <head> section of a document 2357sub head_html 2358{ 2359local $html = $_[0]; 2360return undef if ($html !~ /<HEAD[^>]*>/i || $html !~ /<\/HEAD[^>]*>/i); 2361$html =~ s/^[\000-\377]*<HEAD[^>]*>//gi || &error("Failed to filter <pre>".&html_escape($html)."</pre>"); 2362$html =~ s/<\/HEAD[^>]*>[\000-\377]*//gi || &error("Failed to filter <pre>".&html_escape($html)."</pre>"); 2363$html =~ s/<base[^>]*>//i; 2364return &filter_javascript($html); 2365} 2366 2367# safe_urls(html) 2368# Replaces dangerous-looking URLs in HTML 2369sub safe_urls 2370{ 2371local $html = $_[0]; 2372$html =~ s/((src|href|background)\s*=\s*)([^ '">]+)()/&safe_url($1, $3, $4)/gei; 2373$html =~ s/((src|href|background)\s*=\s*')([^']+)(')/&safe_url($1, $3, $4)/gei; 2374$html =~ s/((src|href|background)\s*=\s*")([^"]+)(")/&safe_url($1, $3, $4)/gei; 2375return $html; 2376} 2377 2378# safe_url(before, url, after) 2379sub safe_url 2380{ 2381local ($before, $url, $after) = @_; 2382if ($url =~ /^#/) { 2383 # Relative link - harmless 2384 return $before.$url.$after; 2385 } 2386elsif ($url =~ /^cid:/i) { 2387 # Definitely safe (CIDs are harmless) 2388 return $before.$url.$after; 2389 } 2390elsif ($url =~ /^(http:|https:)/) { 2391 # Possibly safe, unless refers to local 2392 local ($host, $port, $page, $ssl) = &parse_http_url($url); 2393 local ($hhost, $hport) = split(/:/, $ENV{'HTTP_HOST'}); 2394 $hport ||= $ENV{'SERVER_PORT'}; 2395 if ($host ne $hhost || 2396 $port != $hport || 2397 $ssl != (uc($ENV{'HTTPS'}) eq 'ON' ? 1 : 0)) { 2398 return $before.$url.$after; 2399 } 2400 else { 2401 return $before."_unsafe_link_".$after; 2402 } 2403 } 2404elsif ($url =~ /^mailto:([a-z0-9\.\-\_\@\%]+)/i) { 2405 # A mailto link which is URL-escaped 2406 return $before."reply_mail.cgi?new=1&to=". 2407 &urlize(&un_urlize($1)).$after; 2408 } 2409elsif ($url =~ /^mailto:([a-z0-9\.\-\_\@]+)/i) { 2410 # A mailto link, which we can convert 2411 return $before."reply_mail.cgi?new=1&to=".&urlize($1).$after; 2412 } 2413elsif ($url =~ /\.cgi/) { 2414 # Relative URL like foo.cgi or /foo.cgi or ../foo.cgi - unsafe! 2415 return $before."_unsafe_link_".$after; 2416 } 2417else { 2418 # Non-CGI URL .. assume safe 2419 return $before.$url.$after; 2420 } 2421} 2422 2423# safe_uidl(string) 2424sub safe_uidl 2425{ 2426local $rv = $_[0]; 2427$rv =~ s/\/|\./_/g; 2428return $rv; 2429} 2430 2431# html_to_text(html) 2432# Attempts to convert some HTML to text form 2433sub html_to_text 2434{ 2435local ($h2, $lynx); 2436if (($h2 = &has_command("html2text")) || ($lynx = &has_command("lynx"))) { 2437 # Can use a commonly available external program 2438 local $temp = &transname().".html"; 2439 open(TEMP, ">", $temp); 2440 print TEMP $_[0]; 2441 close(TEMP); 2442 open(OUT, ($lynx ? "$lynx -dump $temp" : "$h2 $temp")." 2>/dev/null |"); 2443 while(<OUT>) { 2444 if ($lynx && $_ =~ /^\s*References\s*$/) { 2445 # Start of Lynx references output 2446 $gotrefs++; 2447 } 2448 elsif ($lynx && $gotrefs && 2449 $_ =~ /^\s*(\d+)\.\s+(http|https|ftp|mailto)/) { 2450 # Skip this URL reference line 2451 } 2452 else { 2453 $text .= $_; 2454 } 2455 } 2456 close(OUT); 2457 unlink($temp); 2458 return $text; 2459 } 2460else { 2461 # Do conversion manually :( 2462 local $html = $_[0]; 2463 $html =~ s/\s+/ /g; 2464 $html =~ s/<p>/\n\n/gi; 2465 $html =~ s/<br>/\n/gi; 2466 $html =~ s/<[^>]+>//g; 2467 $html = &entities_to_ascii($html); 2468 return $html; 2469 } 2470} 2471 2472# folder_select(&folders, selected-folder, name, [extra-options], [by-id], 2473# [auto-submit]) 2474# Returns HTML for selecting a folder 2475sub folder_select 2476{ 2477local ($folders, $folder, $name, $extra, $byid, $auto) = @_; 2478local @opts; 2479push(@opts, @$extra) if ($extra); 2480foreach my $f (@$folders) { 2481 next if ($f->{'hide'} && $f ne $_[1]); 2482 local $umsg; 2483 if (&should_show_unread($f)) { 2484 local ($c, $u) = &mailbox_folder_unread($f); 2485 if ($u) { 2486 $umsg = " ($u)"; 2487 } 2488 } 2489 push(@opts, [ $byid ? &folder_name($f) : $f->{'index'}, 2490 $f->{'name'}.$umsg ]); 2491 } 2492return &ui_select($name, $byid ? &folder_name($folder) : $folder->{'index'}, 2493 \@opts, 1, 0, 0, 0, $auto ? "onChange='form.submit()'" : ""); 2494} 2495 2496# folder_size(&folder, ...) 2497# Sets the 'size' field of one or more folders, and returns the total 2498sub folder_size 2499{ 2500local ($f, $total); 2501foreach $f (@_) { 2502 if ($f->{'type'} == 0 || $f->{'type'} == 7) { 2503 # Single mail file - size is easy 2504 local @st = stat($f->{'file'}); 2505 $f->{'size'} = $st[7]; 2506 } 2507 elsif ($f->{'type'} == 1) { 2508 # Maildir folder size is that of all files in it, except 2509 # sub-folders. 2510 $f->{'size'} = 0; 2511 foreach my $sd ("cur", "new", "tmp") { 2512 $f->{'size'} += &recursive_disk_usage( 2513 $f->{'file'}."/".$sd, '^\\.'); 2514 } 2515 } 2516 elsif ($f->{'type'} == 3) { 2517 # MH folder size is that of all mail files 2518 local $mf; 2519 $f->{'size'} = 0; 2520 opendir(MHDIR, $f->{'file'}); 2521 while($mf = readdir(MHDIR)) { 2522 next if ($mf eq "." || $mf eq ".."); 2523 local @st = stat("$f->{'file'}/$mf"); 2524 $f->{'size'} += $st[7]; 2525 } 2526 closedir(MHDIR); 2527 } 2528 elsif ($f->{'type'} == 4) { 2529 # Get size of IMAP folder 2530 local ($ok, $h, $count, $uidnext) = &imap_login($f); 2531 if ($ok) { 2532 $f->{'size'} = 0; 2533 $f->{'lastchange'} = $uidnext; 2534 local @rv = &imap_command($h, 2535 "FETCH 1:$count (RFC822.SIZE)"); 2536 foreach my $r (@{$rv[1]}) { 2537 if ($r =~ /RFC822.SIZE\s+(\d+)/) { 2538 $f->{'size'} += $1; 2539 } 2540 } 2541 } 2542 } 2543 elsif ($f->{'type'} == 5) { 2544 # Size of a combined folder is the size of all sub-folders 2545 return &folder_size(@{$f->{'subfolders'}}); 2546 } 2547 else { 2548 # Cannot get size of a POP3 folder 2549 $f->{'size'} = undef; 2550 } 2551 $total += $f->{'size'}; 2552 } 2553return $total; 2554} 2555 2556# parse_boolean(string) 2557# Separates a string into a series of and/or separated values. Returns a 2558# mode number (0=or, 1=and, 2=both) and a list of words 2559sub parse_boolean 2560{ 2561local @rv; 2562local $str = $_[0]; 2563local $mode = -1; 2564local $lastandor = 0; 2565while($str =~ /^\s*"([^"]*)"(.*)$/ || 2566 $str =~ /^\s*"([^"]*)"(.*)$/ || 2567 $str =~ /^\s*(\S+)(.*)$/) { 2568 local $word = $1; 2569 $str = $2; 2570 if (lc($word) eq "and") { 2571 if ($mode < 0) { $mode = 1; } 2572 elsif ($mode != 1) { $mode = 2; } 2573 $lastandor = 1; 2574 } 2575 elsif (lc($word) eq "or") { 2576 if ($mode < 0) { $mode = 0; } 2577 elsif ($mode != 0) { $mode = 2; } 2578 $lastandor = 1; 2579 } 2580 else { 2581 if (!$lastandor && @rv) { 2582 $rv[$#rv] .= " ".$word; 2583 } 2584 else { 2585 push(@rv, $word); 2586 } 2587 $lastandor = 0; 2588 } 2589 } 2590$mode = 0 if ($mode < 0); 2591return ($mode, \@rv); 2592} 2593 2594# recursive_files(dir, treat-dirs-as-folders) 2595sub recursive_files 2596{ 2597local ($f, @rv); 2598opendir(DIR, $_[0]); 2599local @files = readdir(DIR); 2600closedir(DIR); 2601foreach $f (@files) { 2602 next if ($f eq "." || $f eq ".." || $f =~ /\.lock$/i || 2603 $f eq "cur" || $f eq "tmp" || $f eq "new" || 2604 $f =~ /^\.imap/i || $f eq ".customflags" || 2605 $f eq "dovecot-uidlist" || $f =~ /^courierimap/ || 2606 $f eq "maildirfolder" || $f eq "maildirsize" || 2607 $f eq "maildircache" || $f eq ".subscriptions" || 2608 $f eq ".usermin-maildircache" || $f =~ /^dovecot\.index/ || 2609 $f =~ /^dovecot-uidvalidity/ || $f eq "subscriptions" || 2610 $f =~ /\.webmintmp\.\d+$/ || $f eq "dovecot-keywords" || 2611 $f =~ /^dovecot\.mailbox/); 2612 local $p = "$_[0]/$f"; 2613 local $added = 0; 2614 if ($_[1] || !-d $p || -d "$p/cur") { 2615 push(@rv, $p); 2616 $added = 1; 2617 } 2618 # If this directory wasn't a folder (or it it in Maildir format), 2619 # search it too. 2620 if (-d "$p/cur" || !$added) { 2621 push(@rv, &recursive_files($p)); 2622 } 2623 } 2624return @rv; 2625} 2626 2627# editable_mail(&mail) 2628# Returns 0 if some mail message should not be editable (ie. internal folder) 2629sub editable_mail 2630{ 2631return $_[0]->{'header'}->{'subject'} !~ /DON'T DELETE THIS MESSAGE.*FOLDER INTERNAL DATA/; 2632} 2633 2634# fix_cids(html, &attachments, url-prefix) 2635# Replaces HTML like img src=cid:XXX with img src=detach.cgi?whatever 2636sub fix_cids 2637{ 2638local $rv = $_[0]; 2639 2640# Fix images referring to CIDs 2641$rv =~ s/(src="|href="|background=")cid:([^"]+)(")/$1.&fix_cid($2,$_[1],$_[2]).$3/gei; 2642$rv =~ s/(src='|href='|background=')cid:([^']+)(')/$1.&fix_cid($2,$_[1],$_[2]).$3/gei; 2643$rv =~ s/(src=|href=|background=)cid:([^\s>]+)()/$1.&fix_cid($2,$_[1],$_[2]).$3/gei; 2644 2645# Fix images whose URL is actually in an attachment 2646$rv =~ s/(src="|href="|background=")([^"]+)(")/$1.&fix_contentlocation($2,$_[1],$_[2]).$3/gei; 2647$rv =~ s/(src='|href='|background=')([^']+)(')/$1.&fix_contentlocation($2,$_[1],$_[2]).$3/gei; 2648$rv =~ s/(src=|href=|background=)([^\s>]+)()/$1.&fix_contentlocation($2,$_[1],$_[2]).$3/gei; 2649return $rv; 2650} 2651 2652# fix_cid(cid, &attachments, url-prefix) 2653sub fix_cid 2654{ 2655local ($cont) = grep { $_->{'header'}->{'content-id'} eq $_[0] || 2656 $_->{'header'}->{'content-id'} eq "<$_[0]>" } @{$_[1]}; 2657if ($cont) { 2658 return "$_[2]&attach=$cont->{'idx'}"; 2659 } 2660else { 2661 return "cid:$_[0]"; 2662 } 2663} 2664 2665# fix_contentlocation(url, &attachments, url-prefix) 2666sub fix_contentlocation 2667{ 2668local ($cont) = grep { $_->{'header'}->{'content-location'} eq $_[0] || 2669 $_->{'header'}->{'content-location'} eq "<$_[0]>" } @{$_[1]}; 2670if ($cont) { 2671 return "$_[2]&attach=$cont->{'idx'}"; 2672 } 2673else { 2674 return $_[0]; 2675 } 2676} 2677 2678# create_cids(html, &results-map) 2679# Replaces all image references in the body like <img src=detach.cgi?...> with 2680# cid: tags, stores in the results map pointers from the index to the CID. 2681sub create_cids 2682{ 2683local ($html, $cidmap) = @_; 2684$html =~ s/(src="|href="|background=")detach.cgi\?([^"]+)(")/$1.&create_cid($2,$cidmap).$3/gei; 2685$html =~ s/(src='|href='|background=')detach.cgi\?([^']+)(')/$1.&create_cid($2,$cidmap).$3/gei; 2686$html =~ s/(src=|href=|background=)detach.cgi\?([^\s>]+)()/$1.&create_cid($2,$cidmap).$3/gei; 2687return $html; 2688} 2689 2690sub create_cid 2691{ 2692local ($args, $cidmap) = @_; 2693if ($args =~ /attach=(\d+)/) { 2694 $create_cid_count++; 2695 $cidmap->{$1} = time().$$.$create_cid_count; 2696 return "cid:".$cidmap->{$1}; 2697 } 2698else { 2699 # No attachment ID! 2700 return ""; 2701 } 2702} 2703 2704# disable_html_images(html, disable?, &urls) 2705# Turn off some or all images in HTML email. Mode 0=Do nothing, 1=Offsite only, 2706# 2=All images. Returns the URL of images found in &urls 2707sub disable_html_images 2708{ 2709local ($html, $dis, $urls) = @_; 2710local $newhtml; 2711while($html =~ /^([\000-\377]*?)(<\s*img[^>]*src=('[^']*'|"[^"]*"|\S+)[^>]*>)([\000-\377]*)/i) { 2712 local ($before, $allimg, $img, $after) = ($1, $2, $3, $4); 2713 $img =~ s/^'(.*)'$/$1/ || $img =~ s/^"(.*)"$/$1/; 2714 push(@$urls, $img) if ($urls); 2715 if ($dis == 0) { 2716 # Don't harm image 2717 $newhtml .= $before.$allimg; 2718 } 2719 elsif ($dis == 1) { 2720 # Don't touch unless offsite 2721 if ($img =~ /^(http|https|ftp):/) { 2722 $newhtml .= $before; 2723 } 2724 else { 2725 $newhtml .= $before.$allimg; 2726 } 2727 } 2728 elsif ($dis == 2) { 2729 # Always remove image 2730 $newhtml .= $before; 2731 } 2732 $html = $after; 2733 } 2734$newhtml .= $html; 2735return $newhtml; 2736} 2737 2738# remove_body_attachments(&mail, &attach) 2739# Returns attachments except for those that make up the message body, and those 2740# that have sub-attachments. 2741sub remove_body_attachments 2742{ 2743local ($mail, $attach) = @_; 2744local ($textbody, $htmlbody) = &find_body($mail); 2745return grep { $_ ne $htmlbody && $_ ne $textbody && !$_->{'attach'} && 2746 $_->{'type'} ne 'message/delivery-status' } @$attach; 2747} 2748 2749# remove_cid_attachments(&mail, &attach) 2750# Returns attachments except for those that are used for inline images in the 2751# HTML body. 2752sub remove_cid_attachments 2753{ 2754local ($mail, $attach) = @_; 2755local ($textbody, $htmlbody) = &find_body($mail); 2756local @rv; 2757foreach my $a (@$attach) { 2758 my $cid = $a->{'header'}->{'content-id'}; 2759 $cid =~ s/^<(.*)>$/$1/g; 2760 my $cl = $a->{'header'}->{'content-location'}; 2761 $cl =~ s/^<(.*)>$/$1/g; 2762 local $inline; 2763 if ($cid && $htmlbody->{'data'} =~ /cid:\Q$cid\E|cid:"\Q$cid\E"|cid:'\Q$cid\E'/) { 2764 # CID-based attachment 2765 $inline = 1; 2766 } 2767 elsif ($cl && $htmlbody->{'data'} =~ /\Q$cl\E/) { 2768 # Content-location based attachment 2769 $inline = 1; 2770 } 2771 if (!$inline) { 2772 push(@rv, $a); 2773 } 2774 } 2775return @rv; 2776} 2777 2778# quoted_message(&mail, quote-mode, sig, 0=any,1=text,2=html, sig-at-top?) 2779# Returns the quoted text, html-flag and body attachment 2780sub quoted_message 2781{ 2782local ($mail, $qu, $sig, $bodymode, $sigtop) = @_; 2783local $mode = $bodymode == 1 ? 1 : 2784 $bodymode == 2 ? 2 : 2785 %userconfig ? $userconfig{'view_html'} : 2786 $config{'view_html'}; 2787local ($plainbody, $htmlbody) = &find_body($mail, $mode); 2788local ($quote, $html_edit, $body); 2789local $cfg = %userconfig ? \%userconfig : \%config; 2790local @writers = &split_addresses($mail->{'header'}->{'from'}); 2791local $writer; 2792if ($writers[0]->[1]) { 2793 $writer = &decode_mimewords($writers[0]->[1])." <". 2794 &decode_mimewords($writers[0]->[0])."> wrote .."; 2795 } 2796else { 2797 $writer = &decode_mimewords($writers[0]->[0])." wrote .."; 2798 } 2799local $tm; 2800if ($cfg->{'reply_date'} && 2801 ($tm = &parse_mail_date($_[0]->{'header'}->{'date'}))) { 2802 local $tmstr = &make_date($tm); 2803 $writer = "On $tmstr $writer"; 2804 } 2805local $qm = %userconfig ? $userconfig{'html_quote'} : $config{'html_quote'}; 2806if (($cfg->{'html_edit'} == 2 || 2807 $cfg->{'html_edit'} == 1 && $htmlbody) && 2808 $bodymode != 1) { 2809 # Create quoted body HTML 2810 if ($htmlbody) { 2811 $body = $htmlbody; 2812 $sig =~ s/\n/<br>\n/g; 2813 if ($qu && $qm == 0) { 2814 # Quoted HTML as cite 2815 $quote = &html_escape($writer)."\n". 2816 "<blockquote type=cite>\n". 2817 &safe_html($htmlbody->{'data'}). 2818 "</blockquote>"; 2819 if ($sigtop) { 2820 $quote = $sig."<br>\n".$quote; 2821 } 2822 else { 2823 $quote = $quote.$sig."<br>\n"; 2824 } 2825 } 2826 elsif ($qu && $qm == 1) { 2827 # Quoted HTML below line 2828 $quote = "<br>$sig<hr>". 2829 &html_escape($writer)."<br>\n". 2830 &safe_html($htmlbody->{'data'}); 2831 } 2832 else { 2833 # Un-quoted HTML 2834 $quote = &safe_html($htmlbody->{'data'}); 2835 if ($sigtop) { 2836 $quote = $sig."<br>\n".$quote; 2837 } 2838 else { 2839 $quote = $quote.$sig."<br>\n"; 2840 } 2841 } 2842 } 2843 elsif ($plainbody) { 2844 $body = $plainbody; 2845 local $pd = $plainbody->{'data'}; 2846 $pd =~ s/^\s+//g; 2847 $pd =~ s/\s+$//g; 2848 if ($qu && $qm == 0) { 2849 # Quoted plain text as HTML as cite 2850 $quote = &html_escape($writer)."\n". 2851 "<blockquote type=cite>\n". 2852 "<pre>$pd</pre>". 2853 "</blockquote>"; 2854 if ($sigtop) { 2855 $quote = $sig."<br>\n".$quote; 2856 } 2857 else { 2858 $quote = $quote.$sig."<br>\n"; 2859 } 2860 } 2861 elsif ($qu && $qm == 1) { 2862 # Quoted plain text as HTML below line 2863 $quote = "<br>$sig<hr>". 2864 &html_escape($writer)."<br>\n". 2865 "<pre>$pd</pre><br>\n"; 2866 } 2867 else { 2868 # Un-quoted plain text as HTML 2869 $quote = "<pre>$pd</pre>"; 2870 if ($sigtop) { 2871 $quote = $sig."<br>\n".$quote; 2872 } 2873 else { 2874 $quote = $quote.$sig."<br>\n"; 2875 } 2876 } 2877 } 2878 $html_edit = 1; 2879 } 2880else { 2881 # Create quoted body text 2882 if ($plainbody) { 2883 $body = $plainbody; 2884 $quote = $plainbody->{'data'}; 2885 } 2886 elsif ($htmlbody) { 2887 $body = $htmlbody; 2888 $quote = &html_to_text($htmlbody->{'data'}); 2889 } 2890 if ($quote && $qu) { 2891 $quote = join("", map { "> $_\n" } 2892 &wrap_lines($quote, 78)); 2893 } 2894 $quote = $writer."\n".$quote if ($quote && $qu); 2895 if ($sig && $sigtop) { 2896 $quote = $sig."\n".$quote; 2897 } 2898 elsif ($sig && !$sigtop) { 2899 $quote = $quote.$sig."\n"; 2900 } 2901 } 2902return ($quote, $html_edit, $body); 2903} 2904 2905# modification_time(&folder) 2906# Returns the unix time on which this folder was last modified, or 0 if unknown 2907sub modification_time 2908{ 2909if ($_[0]->{'type'} == 0) { 2910 # Modification time of file 2911 local @st = stat($_[0]->{'file'}); 2912 return $st[9]; 2913 } 2914elsif ($_[0]->{'type'} == 1) { 2915 # Greatest modification time of cur/new directory 2916 local @stcur = stat("$_[0]->{'file'}/cur"); 2917 local @stnew = stat("$_[0]->{'file'}/new"); 2918 return $stcur[9] > $stnew[9] ? $stcur[9] : $stnew[9]; 2919 } 2920elsif ($_[0]->{'type'} == 2 || $_[0]->{'type'} == 4) { 2921 # Cannot know for POP3 or IMAP folders 2922 return 0; 2923 } 2924elsif ($_[0]->{'type'} == 3) { 2925 # Modification time of MH folder 2926 local @st = stat($_[0]->{'file'}); 2927 return $st[9]; 2928 } 2929else { 2930 # Huh? 2931 return 0; 2932 } 2933} 2934 2935# requires_delivery_notification(&mail) 2936sub requires_delivery_notification 2937{ 2938return $_[0]->{'header'}->{'disposition-notification-to'} || 2939 $_[0]->{'header'}->{'read-reciept-to'}; 2940} 2941 2942# send_delivery_notification(&mail, [from-addr], manual) 2943# Send an email containing delivery status information 2944sub send_delivery_notification 2945{ 2946local ($mail, $from) = @_; 2947$from ||= $mail->{'header'}->{'to'}; 2948local $host = &get_display_hostname(); 2949local $to = &requires_delivery_notification($mail); 2950local $product = &get_product_name(); 2951$product = ucfirst($product); 2952local $version = &get_webmin_version(); 2953local ($taddr) = &split_addresses($mail->{'header'}->{'to'}); 2954local $disp = $manual ? "manual-action/MDN-sent-manually" 2955 : "automatic-action/MDN-sent-automatically"; 2956local $dsn = <<EOF; 2957Reporting-UA: $host; $product $version 2958Original-Recipient: rfc822;$taddr->[0] 2959Final-Recipient: rfc822;$taddr->[0] 2960Original-Message-ID: $mail->{'header'}->{'message-id'} 2961Disposition: $disp; displayed 2962EOF 2963local $dmail = { 2964 'headers' => 2965 [ [ 'From' => $from ], 2966 [ 'To' => $to ], 2967 [ 'Subject' => 'Delivery notification' ], 2968 [ 'Content-type' => 'multipart/report; report-type=disposition-notification' ], 2969 [ 'Content-Transfer-Encoding' => '7bit' ] ], 2970 'attach' => [ 2971 { 'headers' => [ [ 'Content-type' => 'text/plain' ] ], 2972 'data' => "This is a delivery status notification for the email sent to:\n$mail->{'header'}->{'to'}\non the date:\n$mail->{'header'}->{'date'}\nwith the subject:\n$mail->{'header'}->{'subject'}\n" }, 2973 { 'headers' => [ [ 'Content-type' => 2974 'message/disposition-notification' ], 2975 [ 'Content-Transfer-Encoding' => '7bit' ] ], 2976 'data' => $dsn } 2977 ] }; 2978eval { local $main::errors_must_die = 1; &send_mail($dmail); }; 2979return $to; 2980} 2981 2982# find_subfolder(&folder, name) 2983# Returns the sub-folder with some name 2984sub find_subfolder 2985{ 2986local ($folder, $sfn) = @_; 2987if ($folder->{'type'} == 5) { 2988 # Composite 2989 foreach my $sf (@{$folder->{'subfolders'}}) { 2990 return $sf if (&folder_name($sf) eq $sfn); 2991 } 2992 } 2993elsif ($folder->{'type'} == 6) { 2994 # Virtual 2995 foreach my $m (@{$folder->{'members'}}) { 2996 return $m->[0] if (&folder_name($m->[0]) eq $sfn); 2997 } 2998 } 2999return undef; 3000} 3001 3002# find_named_folder(name, &folders, [&cache]) 3003# Finds a folder by ID, filename, server name or displayed name 3004sub find_named_folder 3005{ 3006local ($name, $folders, $cache) = @_; 3007local $rv; 3008if ($cache && exists($cache->{$name})) { 3009 # In cache 3010 $rv = $cache->{$name}; 3011 } 3012else { 3013 # Need to lookup 3014 ($rv) = grep { &folder_name($_) eq $name } @$folders if (!$rv); 3015 ($rv) = grep { my $escfile = $_->{'file'}; 3016 $escfile =~ s/\s/_/g; 3017 $escfile eq $name || 3018 $_->{'file'} eq $name || 3019 $_->{'server'} eq $name } @$folders if (!$rv); 3020 ($rv) = grep { my $escname = $_->{'name'}; 3021 $escname =~ s/\s/_/g; 3022 $escname eq $name || 3023 $_->{'name'} eq $name } @$folders if (!$rv); 3024 $cache->{$name} = $rv if ($cache); 3025 } 3026return $rv; 3027} 3028 3029# folder_name(&folder) 3030# Returns a unique identifier for a folder, based on it's filename or ID 3031sub folder_name 3032{ 3033my $rv = $_[0]->{'id'} || 3034 $_[0]->{'file'} || 3035 $_[0]->{'server'} || 3036 $_[0]->{'name'}; 3037$rv =~ s/\s/_/g; 3038return $rv; 3039} 3040 3041# set_folder_lastmodified(&folders) 3042# Sets the last-modified time and sortable flag on all given folders 3043sub set_folder_lastmodified 3044{ 3045local ($folders) = @_; 3046foreach my $folder (@$folders) { 3047 if ($folder->{'type'} == 0 || $folder->{'type'} == 3) { 3048 # For an mbox or MH folder, the last modified date is just that 3049 # of the file or directory itself 3050 local @st = stat($folder->{'file'}); 3051 $folder->{'lastchange'} = $st[9]; 3052 $folder->{'sortable'} = 1; 3053 } 3054 elsif ($folder->{'type'} == 1) { 3055 # For a Maildir folder, the date is that of the newest 3056 # sub-directory (cur, tmp or new) 3057 $folder->{'lastchange'} = 0; 3058 foreach my $sf ("cur", "tmp", "new") { 3059 local @st = stat("$folder->{'file'}/$sf"); 3060 $folder->{'lastchange'} = $st[9] 3061 if ($st[9] > $folder->{'lastchange'}); 3062 } 3063 $folder->{'sortable'} = 1; 3064 } 3065 elsif ($folder->{'type'} == 5) { 3066 # For a composite folder, the date is that of the newest 3067 # sub-folder, OR the folder file itself 3068 local @st = stat($folder->{'folderfile'}); 3069 $folder->{'lastchange'} = $st[9]; 3070 &set_folder_lastmodified($folder->{'subfolders'}); 3071 foreach my $sf (@{$folder->{'subfolders'}}) { 3072 $folder->{'lastchange'} = $sf->{'lastchange'} 3073 if ($sf->{'lastchange'} > 3074 $folder->{'lastchange'}); 3075 } 3076 $folder->{'sortable'} = 1; 3077 } 3078 elsif ($folder->{'type'} == 6) { 3079 # For a virtual folder, the date is that of the newest 3080 # sub-folder, OR the folder file itself 3081 local @st = stat($folder->{'folderfile'}); 3082 $folder->{'lastchange'} = $st[9]; 3083 my %done; 3084 foreach my $m (@{$folder->{'members'}}) { 3085 if (!$done{$m->[0]}++) { 3086 &set_folder_lastmodified([ $m->[0] ]); 3087 $folder->{'lastchange'} = 3088 $m->[0]->{'lastchange'} 3089 if ($m->[0]->{'lastchange'} > 3090 $folder->{'lastchange'}); 3091 } 3092 } 3093 $folder->{'sortable'} = 1; 3094 } 3095 else { 3096 # For POP3 and IMAP folders, we don't know the last change 3097 $folder->{'lastchange'} = undef; 3098 $folder->{'sortable'} = 1; 3099 } 3100 } 3101} 3102 3103# mail_preview(&mail, [characters]) 3104# Returns a short text preview of a message body 3105sub mail_preview 3106{ 3107local ($mail, $chars) = @_; 3108$chars ||= 100; 3109local ($textbody, $htmlbody, $body) = &find_body($mail, 0); 3110local $data = $body->{'data'}; 3111$data =~ s/\r?\n/ /g; 3112$data = substr($data, 0, $chars); 3113if ($data =~ /\S/) { 3114 return $data; 3115 } 3116return undef; 3117} 3118 3119# open_dbm_db(&hash, file, mode) 3120# Attempts to open a DBM, first using SDBM_File, and then NDBM_File 3121sub open_dbm_db 3122{ 3123local ($hash, $file, $mode) = @_; 3124eval "use SDBM_File"; 3125dbmopen(%$hash, $file, $mode); 3126eval { $hash->{'1111111111'} = 'foo bar' }; 3127if ($@) { 3128 dbmclose(%$hash); 3129 eval "use NDBM_File"; 3130 dbmopen(%$hash, $file, $mode); 3131 } 3132} 3133 3134# generate_message_id(from-address) 3135# Returns a unique ID for a new message 3136sub generate_message_id 3137{ 3138local ($fromaddr) = @_; 3139local ($finfo) = &split_addresses($fromaddr); 3140local $dom; 3141if ($finfo && $finfo->[0] =~ /\@(\S+)$/) { 3142 $dom = $1; 3143 } 3144else { 3145 $dom = &get_system_hostname(); 3146 } 3147return "<".time().".".$$."\@".$dom.">"; 3148} 3149 3150# type_to_extension(type) 3151# Returns a good extension for a MIME type 3152sub type_to_extension 3153{ 3154local ($type) = @_; 3155$type =~ s/;.*$//; 3156local ($mt) = grep { lc($_->{'type'}) eq lc($type) } &list_mime_types(); 3157if ($mt && $m->{'exts'}->[0]) { 3158 return $m->{'exts'}->[0]; 3159 } 3160elsif ($type =~ /^text\//) { 3161 return ".txt"; 3162 } 3163else { 3164 my @p = split(/\//, $type); 3165 return $p[1]; 3166 } 3167} 3168 3169# should_show_unread(&folder) 3170# Returns 1 if we should show unread counts for some folder 3171sub should_show_unread 3172{ 3173local ($folder) = @_; 3174local $su = $userconfig{'show_unread'} || $config{'show_unread'}; 3175 3176# Work out if all sub-folders are IMAP 3177local $allimap; 3178if ($su == 2) { 3179 # Doesn't matter 3180 } 3181elsif ($su == 1 && $config{'mail_system'} == 4) { 3182 # Totally IMAP mode 3183 $allimap = 1; 3184 } 3185elsif ($su == 1) { 3186 if ($folder->{'type'} == 5) { 3187 $allimap = 1; 3188 foreach my $sf (@{$folder->{'subfolders'}}) { 3189 $allimap = 0 if (!&should_show_unread($sf)); 3190 } 3191 } 3192 elsif ($folder->{'type'} == 6) { 3193 $allimap = 1; 3194 foreach my $mem (@{$folder->{'members'}}) { 3195 $allimap = 0 if (!&should_show_unread($mem->[0])); 3196 } 3197 } 3198 } 3199 3200return $su == 2 || # All folders 3201 ($folder->{'type'} == 4 || # Only IMAP and derived 3202 $folder->{'type'} == 5 && $allimap || 3203 $folder->{'type'} == 6 && $allimap) && $su == 1; 3204} 3205 3206# mail_has_attachments(&mail|&mails, &folder) 3207# Returns an array of flags, each being 1 if the message has attachments, 0 3208# if not. Uses a cache DBM by message ID and fetches the whole mail if needed. 3209sub mail_has_attachments 3210{ 3211local ($mails, $folder) = @_; 3212if (ref($mails) ne 'ARRAY') { 3213 # Just one 3214 $mails = [ $mails ]; 3215 } 3216 3217# Open cache DBM 3218if (!%hasattach) { 3219 local $hasattach_file; 3220 if ($module_info{'usermin'}) { 3221 $hasattach_file = "$user_module_config_directory/attach"; 3222 } 3223 else { 3224 $hasattach_file = "$module_config_directory/attach"; 3225 if (!glob($hasattach_file."*")) { 3226 $hasattach_file = "$module_var_directory/attach"; 3227 } 3228 } 3229 &open_dbm_db(\%hasattach, $hasattach_file, 0600); 3230 } 3231 3232# See which mail we already know about 3233local @rv = map { undef } @$mails; 3234local @needbody; 3235for(my $i=0; $i<scalar(@rv); $i++) { 3236 local $mail = $mails->[$i]; 3237 local $mid = &get_mail_message_id($mail); 3238 if ($mid && defined($hasattach{$mid})) { 3239 # Already cached .. use it 3240 $rv[$i] = $hasattach{$mid}; 3241 } 3242 elsif (!$mail->{'body'} && $mail->{'size'} > 1024*1024) { 3243 # Message is big .. just assume it has attachments 3244 $rv[$i] = 1; 3245 } 3246 elsif (!$mail->{'body'}) { 3247 # Need to get body 3248 push(@needbody, $i); 3249 } 3250 } 3251 3252# We need to actually fetch some message bodies to check for attachments 3253if (@needbody) { 3254 local (@needmail, %oldread); 3255 foreach my $i (@needbody) { 3256 push(@needmail, $mails->[$i]); 3257 } 3258 @needmail = &mailbox_select_mails($folder, 3259 [ map { $_->{'id'} } @needmail ], 0); 3260 foreach my $i (@needbody) { 3261 $mails->[$i] = shift(@needmail); 3262 } 3263 } 3264 3265# Now we have bodies, check for attachments 3266for(my $i=0; $i<scalar(@rv); $i++) { 3267 next if (defined($rv[$i])); 3268 local $mail = $mails->[$i]; 3269 if (!$mail) { 3270 # Couldn't read from server 3271 $rv[$i] = 0; 3272 next; 3273 } 3274 if (!@{$mail->{'attach'}}) { 3275 # Parse out attachments 3276 &parse_mail($mail, undef, 0); 3277 } 3278 3279 # Check for non-text attachments 3280 $rv[$i] = 0; 3281 foreach my $a (@{$mail->{'attach'}}) { 3282 if ($a->{'type'} =~ /^text\/(plain|html)/i || 3283 $a->{'type'} eq 'text') { 3284 # Text part .. may be an attachment 3285 if ($a->{'header'}->{'content-disposition'} =~ 3286 /^attachment/i) { 3287 $rv[$i] = 1; 3288 } 3289 } 3290 elsif ($a->{'type'} !~ /^multipart\/(mixed|alternative)/) { 3291 # Non-text .. assume this means we have an attachment 3292 $rv[$i] = 1; 3293 } 3294 } 3295 } 3296 3297# Update the cache 3298for(my $i=0; $i<scalar(@rv); $i++) { 3299 local $mail = $mails->[$i]; 3300 local $mid = &get_mail_message_id($mail); 3301 if ($mid && !defined($hasattach{$mid})) { 3302 $hasattach{$mid} = $rv[$i] 3303 } 3304 } 3305 3306return wantarray ? @rv : $rv[0]; 3307} 3308 3309# get_mail_message_id(&mail) 3310# Returns a message ID suitable for use in a DBM 3311sub get_mail_message_id 3312{ 3313my ($mail) = @_; 3314my $mid = $mail->{'header'}->{'message-id'} || $mail->{'id'}; 3315if (length($mid) > 1024) { 3316 $mid = substr($mid, 0, 1024); 3317 } 3318return $mid; 3319} 3320 3321# show_delivery_status(&dstatus) 3322# Show the delivery status HTML for some email 3323sub show_delivery_status 3324{ 3325local ($dstatus) = @_; 3326local $ds = &parse_delivery_status($dstatus->{'data'}); 3327$dtxt = $ds->{'status'} =~ /^2\./ ? $text{'view_dstatusok'} 3328 : $text{'view_dstatus'}; 3329print &ui_table_start($dtxt, "width=100%", 2, [ "width=10% nowrap" ]); 3330foreach $dsh ('final-recipient', 'diagnostic-code', 3331 'remote-mta', 'reporting-mta') { 3332 if ($ds->{$dsh}) { 3333 $ds->{$dsh} =~ s/^\S+;//; 3334 print &ui_table_row($text{'view_'.$dsh}, 3335 &html_escape($ds->{$dsh})); 3336 } 3337 } 3338print &ui_table_end(); 3339} 3340 3341# attachments_table(&attach, folder, view-url, detach-url, 3342# [viewmail-url, viewmail-field], [show-checkboxes]) 3343# Prints an HTML table of attachments. Returns a list of those that can be 3344# server-side detached. 3345sub attachments_table 3346{ 3347local ($attach, $folder, $viewurl, $detachurl, $mailurl, $idfield, $cbs) = @_; 3348local %typemap = map { $_->{'type'}, $_->{'desc'} } &list_mime_types(); 3349local $qid = &urlize($id); 3350local $rv; 3351local (@files, @actions, @detach, @sizes, @titles, @links); 3352foreach my $a (@$attach) { 3353 local $fn; 3354 local $size = &nice_size(length($a->{'data'})); 3355 local $cb; 3356 if (!$a->{'type'}) { 3357 # An actual email 3358 push(@files, &text('view_sub2', $a->{'header'}->{'from'})); 3359 $fn = "mail.txt"; 3360 $size = &nice_size($a->{'size'}); 3361 } 3362 elsif ($a->{'type'} eq 'message/rfc822') { 3363 # Attached email 3364 local $amail = &extract_mail($a->{'data'}); 3365 if ($amail && $amail->{'header'}->{'from'}) { 3366 push(@files, &text('view_sub2', 3367 $amail->{'header'}->{'from'})); 3368 } 3369 else { 3370 push(@files, &text('view_sub')); 3371 } 3372 $fn = "mail.txt"; 3373 } 3374 elsif ($a->{'filename'}) { 3375 # Known filename 3376 $fn = &decode_mimewords($a->{'filename'}); 3377 local $shortfn = $fn; 3378 if (length($shortfn) > 80) { 3379 $shortfn = substr($shortfn, 0, 80)."..."; 3380 } 3381 push(@files, $shortfn); 3382 push(@detach, [ $a->{'idx'}, $fn ]); 3383 } 3384 else { 3385 # No filename 3386 push(@files, $text{'view_anofile'}); 3387 $fn = "file.".&type_to_extension($a->{'type'}); 3388 push(@detach, [ $a->{'idx'}, $fn ]); 3389 } 3390 push(@sizes, $size); 3391 push(@titles, $files[$#files]."<br>".$size); 3392 if ($a->{'error'}) { 3393 $titles[$#titles] .= "<br><font size=-1>($a->{'error'})</font>"; 3394 } 3395 $fn =~ s/ /_/g; 3396 $fn =~ s/\#/_/g; 3397 $fn = &urlize($fn); 3398 local @a; 3399 local $detachfile = $detachurl; 3400 $detachfile =~ s/\?/\/$fn\?/; 3401 if (!$a->{'type'}) { 3402 # Complete email for viewing 3403 local $qmid = &urlize($a->{$idfield}); 3404 push(@links, "$mailurl&$idfield=$qmid&folder=$folder->{'index'}"); 3405 } 3406 elsif ($a->{'type'} eq 'message/rfc822') { 3407 # Attached sub-email 3408 push(@links, $viewurl."&sub=$a->{'idx'}"); 3409 } 3410 else { 3411 # Regular attachment 3412 push(@links, $detachfile."&attach=$a->{'idx'}"); 3413 } 3414 push(@a, "<a href='$links[$#links]'>$text{'view_aview'}</a>"); 3415 push(@a, "<a href='$links[$#links]' target=_blank>$text{'view_aopen'}</a>"); 3416 if ($a->{'type'}) { 3417 push(@a, "<a href='$detachfile&attach=$a->{'idx'}&save=1'>$text{'view_asave'}</a>"); 3418 } 3419 if ($a->{'type'} eq 'message/rfc822') { 3420 push(@a, "<a href='$detachfile&attach=$a->{'idx'}&type=text/plain$subs'>$text{'view_aplain'}</a>"); 3421 } 3422 push(@actions, \@a); 3423 } 3424local @tds = ( "width=50%", "width=25%", "width=10%", "width=15% nowrap" ); 3425if ($cbs) { 3426 unshift(@tds, "width=5"); 3427 } 3428print &ui_columns_start([ 3429 $cbs ? ( "" ) : ( ), 3430 $text{'view_afile'}, 3431 $text{'view_atype'}, 3432 $text{'view_asize'}, 3433 $text{'view_aactions'}, 3434 ], 100, 0, \@tds); 3435for(my $i=0; $i<@files; $i++) { 3436 local $type = $attach[$i]->{'type'} || "message/rfc822"; 3437 local $typedesc = $typemap{lc($type)} || $type; 3438 local @cols = ( 3439 "<a href='$links[$i]'>".&html_escape($files[$i])."</a>", 3440 $typedesc, 3441 $sizes[$i], 3442 &ui_links_row($actions[$i]), 3443 ); 3444 if ($cbs) { 3445 print &ui_checked_columns_row(\@cols, \@tds, 3446 $cbs, $attach->[$i]->{'idx'}, 1); 3447 } 3448 else { 3449 print &ui_columns_row(\@cols, \@tds); 3450 } 3451 } 3452print &ui_columns_end(); 3453return @detach; 3454} 3455 3456# message_icons(&mail, showto, &folder) 3457# Returns a list of icon images for some mail 3458sub message_icons 3459{ 3460local ($mail, $showto, $folder) = @_; 3461local @rv; 3462if (&mail_has_attachments($mail, $folder)) { 3463 push(@rv, "<img src=images/attach.gif alt='A'>"); 3464 } 3465local $p = int($mail->{'header'}->{'x-priority'}); 3466if ($p == 1) { 3467 push(@rv, "<img src=images/p1.gif alt='P1'>"); 3468 } 3469elsif ($p == 2) { 3470 push(@rv, "<img src=images/p2.gif alt='P2'>"); 3471 } 3472 3473# Show icons if special or replied to 3474local $read = &get_mail_read($folder, $mail); 3475if ($read&2) { 3476 push(@rv, "<img src=images/special.gif alt='*'>"); 3477 } 3478if ($read&4) { 3479 push(@rv, "<img src=images/replied.gif alt='R'>"); 3480 } 3481 3482if ($showto && defined(&open_dsn_hash)) { 3483 # Show icons if DSNs received 3484 &open_dsn_hash(); 3485 local $mid = &get_mail_message_id($mail); 3486 if ($dsnreplies{$mid}) { 3487 push(@rv, "<img src=images/dsn.gif alt='R'>"); 3488 } 3489 if ($delreplies{$mid}) { 3490 local ($bounce) = grep { /^\!/ } 3491 split(/\s+/, $delreplies{$mid}); 3492 local $img = $bounce ? "red.gif" : "box.gif"; 3493 push(@rv, "<img src=images/$img alt='D'>"); 3494 } 3495 } 3496return @rv; 3497} 3498 3499# show_mail_printable(&mail, body, textbody, htmlbody) 3500# Output HTML for printing a message 3501sub show_mail_printable 3502{ 3503local ($mail, $body, $textbody, $htmlbody) = @_; 3504 3505# Display the headers 3506print &ui_table_start($text{'view_headers'}, "width=100%", 2); 3507print &ui_table_row($text{'mail_from'}, 3508 &convert_header_for_display($mail->{'header'}->{'from'})); 3509print &ui_table_row($text{'mail_to'}, 3510 &convert_header_for_display($mail->{'header'}->{'to'})); 3511if ($mail->{'header'}->{'cc'}) { 3512 print &ui_table_row($text{'mail_cc'}, 3513 &convert_header_for_display($mail->{'header'}->{'cc'})); 3514 } 3515print &ui_table_row($text{'mail_date'}, 3516 &convert_header_for_display($mail->{'header'}->{'date'})); 3517print &ui_table_row($text{'mail_subject'}, 3518 &convert_header_for_display( 3519 $mail->{'header'}->{'subject'})); 3520print &ui_table_end(),"<br>\n"; 3521 3522# Just display the mail body for printing 3523print &ui_table_start(undef, "width=100%", 2); 3524if ($body eq $textbody) { 3525 my $plain; 3526 foreach my $l (&wrap_lines($body->{'data'}, 3527 $config{'wrap_width'} || 3528 $userconfig{'wrap_width'})) { 3529 $plain .= &eucconv_and_escape($l)."\n"; 3530 } 3531 print &ui_table_row(undef, "<pre>$plain</pre>", 2); 3532 } 3533elsif ($body eq $htmlbody) { 3534 print &ui_table_row(undef, 3535 &safe_html($body->{'data'}), 2); 3536 } 3537print &ui_table_end(); 3538} 3539 3540# show_attachments_fields(count, server-side) 3541# Outputs HTML for new attachment fields 3542sub show_attachments_fields 3543{ 3544local ($count, $server_attach) = @_; 3545 3546# Work out if any attachments are supported 3547my $any_attach = $server_attach || !$main::no_browser_uploads; 3548 3549if ($any_attach && &supports_javascript()) { 3550 # Javascript to increase attachments fields 3551 print <<EOF; 3552<script> 3553function add_attachment() 3554{ 3555var block = document.getElementById("attachblock"); 3556if (block) { 3557 var count = 0; 3558 var first_input = document.forms[0]["attach0"]; 3559 while(document.forms[0]["attach"+count]) { count++; } 3560 var new_input = document.createElement('input'); 3561 new_input.setAttribute('name', "attach"+count); 3562 new_input.setAttribute('type', 'file'); 3563 if (first_input) { 3564 new_input.setAttribute('size', 3565 first_input.getAttribute('size')); 3566 new_input.setAttribute('class', 3567 first_input.getAttribute('class')); 3568 } 3569 block.appendChild(new_input); 3570 var new_br = document.createElement('br'); 3571 block.appendChild(new_br); 3572 } 3573return false; 3574} 3575function add_ss_attachment() 3576{ 3577var block = document.getElementById("ssattachblock"); 3578if (block) { 3579 var count = 0; 3580 var first_input = document.forms[0]["file0"]; 3581 while(document.forms[0]["file"+count]) { count++; } 3582 var new_input = document.createElement('input'); 3583 new_input.setAttribute('name', "file"+count); 3584 if (first_input) { 3585 new_input.setAttribute('size', 3586 first_input.getAttribute('size')); 3587 new_input.setAttribute('class', 3588 first_input.getAttribute('class')); 3589 } 3590 block.appendChild(new_input); 3591 var new_br = document.createElement('br'); 3592 block.appendChild(new_br); 3593 } 3594return false; 3595} 3596</script> 3597EOF 3598 } 3599 3600if ($any_attach) { 3601 # Show form for attachments (both uploaded and server-side) 3602 print &ui_table_start($server_attach ? $text{'reply_attach2'} 3603 : $text{'reply_attach3'}, 3604 "width=100%", 2); 3605 } 3606 3607# Uploaded attachments 3608if (!$main::no_browser_uploads) { 3609 my $atable = "<div>\n"; 3610 for(my $i=0; $i<$count; $i++) { 3611 $atable .= &ui_upload("attach$i", 80, 0, 3612 "style='width:100%'", 1)."<br>"; 3613 } 3614 $atable .= "</div> <div id=attachblock></div>\n"; 3615 print &ui_hidden("attachcount", int($i)),"\n"; 3616 print &ui_table_row(undef, $atable, 2); 3617 } 3618if ($server_attach) { 3619 my $atable = "<div>\n"; 3620 for(my $i=0; $i<$count; $i++) { 3621 $atable .= &ui_textbox("file$i", undef, 60, 0, undef, 3622 "style='width:95%'"). 3623 &file_chooser_button("file$i"),"<br>\n"; 3624 } 3625 $atable .= "</div> <div id=sattachblock></div>\n"; 3626 print &ui_table_row(undef, $atable, 2); 3627 print &ui_hidden("ssattachcount", int($i)),"\n"; 3628 } 3629 3630# Links to add more fields 3631my @addlinks; 3632if (!$main::no_browser_uploads && &supports_javascript()) { 3633 push(@addlinks, "<a href='' onClick='return add_attachment()'>". 3634 "$text{'reply_addattach'}</a>" ); 3635 } 3636if ($server_attach && &supports_javascript()) { 3637 push(@addlinks, "<a href='' onClick='return add_ss_attachment()'>". 3638 "$text{'reply_addssattach'}</a>" ); 3639 } 3640if ($any_attach) { 3641 print &ui_table_row(undef, &ui_links_row(\@addlinks), 2); 3642 print &ui_table_end(); 3643 } 3644} 3645 3646# inputs_to_hiddens([&in]) 3647# Converts a hash as created by ReadParse into a list of names and values 3648sub inputs_to_hiddens 3649{ 3650my $in = $_[0] || \%in; 3651my @hids; 3652foreach $i (keys %$in) { 3653 push(@hids, map { [ $i, $_ ] } split(/\0/, $in->{$i})); 3654 } 3655return @hids; 3656} 3657 3658# ui_address_field(name, value, from-mode?, multi-line?) 3659# Returns HTML for a field for selecting an email address 3660sub ui_address_field 3661{ 3662return &theme_ui_address_field(@_) if (defined(&theme_ui_address_field)); 3663local ($name, $value, $from, $multi) = @_; 3664local @faddrs; 3665if (defined(&list_addresses)) { 3666 @faddrs = grep { $_->[3] } &list_addresses(); 3667 } 3668local $f = $multi ? &ui_textarea($name, $value, 3, 40, undef, 0, 3669 "style='width:95%'") 3670 : &ui_textbox($name, $value, 40, 0, undef, 3671 "style='width:95%'"); 3672if ((!$from || @faddrs) && defined(&address_button)) { 3673 $f .= " ".&address_button($name, 0, $from); 3674 } 3675return $f; 3676} 3677 3678# Returns 1 if spell checking is supported on this system 3679sub can_spell_check_text 3680{ 3681return &has_command("ispell"); 3682} 3683 3684# spell_check_text(text) 3685# Checks for spelling errors in some text, and returns a list of those found 3686# as HTML strings 3687sub spell_check_text 3688{ 3689local ($plainbody) = @_; 3690local @errs; 3691pipe(INr, INw); 3692pipe(OUTr, OUTw); 3693select(INw); $| = 1; select(OUTr); $| = 1; select(STDOUT); 3694if (!fork()) { 3695 close(INw); 3696 close(OUTr); 3697 untie(*STDIN); 3698 untie(*STDOUT); 3699 untie(*STDERR); 3700 open(STDOUT, ">&OUTw"); 3701 open(STDERR, ">/dev/null"); 3702 open(STDIN, "<&INr"); 3703 exec("ispell -a"); 3704 exit; 3705 } 3706close(INr); 3707close(OUTw); 3708local $indent = " " x 4; 3709local $SIG{'PIPE'} = 'IGNORE'; 3710local @errs; 3711foreach $line (split(/\n+/, $plainbody)) { 3712 next if ($line !~ /\S/); 3713 print INw $line,"\n"; 3714 local @lerrs; 3715 while(1) { 3716 ($spell = <OUTr>) =~ s/\r|\n//g; 3717 last if (!$spell); 3718 if ($spell =~ /^#\s+(\S+)/) { 3719 # Totally unknown word 3720 push(@lerrs, $indent.&text('send_eword', 3721 "<i>".&html_escape($1)."</i>")); 3722 } 3723 elsif ($spell =~ /^&\s+(\S+)\s+(\d+)\s+(\d+):\s+(.*)/) { 3724 # Maybe possible word, with options 3725 push(@lerrs, $indent.&text('send_eword2', 3726 "<i>".&html_escape($1)."</i>", 3727 "<i>".&html_escape($4)."</i>")); 3728 } 3729 elsif ($spell =~ /^\?\s+(\S+)/) { 3730 # Maybe possible word 3731 push(@lerrs, $indent.&text('send_eword', 3732 "<i>".&html_escape($1)."</i>")); 3733 } 3734 } 3735 if (@lerrs) { 3736 push(@errs, &text('send_eline', 3737 "<tt>".&html_escape($line)."</tt>")."<br>". 3738 join("<br>", @lerrs)); 3739 } 3740 } 3741close(INw); 3742close(OUTr); 3743return @errs; 3744} 3745 3746# get_mail_charset(&mail, &body) 3747# Returns the character set to use for the HTML page for some email 3748sub get_mail_charset 3749{ 3750my ($mail, $body) = @_; 3751my $ctype; 3752if ($body) { 3753 $ctype = $body->{'header'}->{'content-type'}; 3754 } 3755$ctype ||= $mail->{'header'}->{'content-type'}; 3756if ($ctype =~ /charset="([a-z0-9\-]+)"/i || 3757 $ctype =~ /charset='([a-z0-9\-]+)'/i || 3758 $ctype =~ /charset=([a-z0-9\-]+)/i) { 3759 $charset = $1; 3760 } 3761## Special handling of HTML header charset ($force_charset): 3762## For japanese text(ISO-2022-JP/EUC=JP/SJIS), the HTML output and 3763## text contents ($bodycontents) are already converted to EUC, 3764## so overriding HTML charset to that in the mail header ($charset) 3765## is generally wrong. (cf. mailbox/boxes-lib.pl:eucconv()) 3766if ( &get_charset() =~ /^EUC/i ) { # EUC-JP,EUC-KR 3767 return undef; 3768 } 3769else { 3770 return $charset; 3771 } 3772} 3773 3774# switch_to_folder_user(&folder) 3775# If a folder has a user, switch the UID and GID used for writes to it 3776sub switch_to_folder_user 3777{ 3778my ($folder) = @_; 3779if ($folder->{'user'} && $switch_to_folder_count == 0) { 3780 &set_mail_open_user($folder->{'user'}); 3781 } 3782$switch_to_folder_count++; 3783} 3784 3785# switch_from_folder_user(&folder) 3786# Undoes the change made by switch_to_folder_user 3787sub switch_from_folder_user 3788{ 3789my ($folder) = @_; 3790if ($switch_to_folder_count) { 3791 $switch_to_folder_count--; 3792 if ($switch_to_folder_count == 0) { 3793 &clear_mail_open_user(); 3794 } 3795 } 3796else { 3797 print STDERR "switch_from_folder_user called more often ", 3798 "than switch_to_folder_user!\n"; 3799 } 3800} 3801 3802# remove_spam_subject(&mail) 3803# Removes the [spam] prefix from the subject, if there is one 3804sub remove_spam_subject 3805{ 3806my ($mail) = @_; 3807my $rv = 0; 3808foreach my $h (@{$mail->{'headers'}}) { 3809 if (lc($h->[0]) eq 'subject' && $h->[1] =~ /^\[spam\]\s*(.*)$/i) { 3810 $h->[1] = $1; 3811 $rv = 1; 3812 } 3813 } 3814return $rv; 3815} 3816 38171; 3818