mailboxes/folders-lib.pl

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