diff --git a/mailboxes/boxes-lib.pl b/mailboxes/boxes-lib.pl index 167f695f4..aeca28b7e 100755 --- a/mailboxes/boxes-lib.pl +++ b/mailboxes/boxes-lib.pl @@ -175,7 +175,7 @@ local ($file, $ids, $headersonly) = @_; local @rv; local (@rv); -my %index; +my (%index, %midmap); local $gotindex; local $umf = &user_mail_file($file); @@ -191,24 +191,23 @@ foreach my $i (@$ids) { ($1 eq '-' && !$dash) ? 0 : 1; print DEBUG "seeking to $pos in $umf, got $ll"; if (!$fromok) { - # Oh noes! Need to find it + # Oh noes! Need to find it, using a map from message IDs to + # positions built once from the index if (!$gotindex++) { &build_dbm_index($file, \%index); - } - $pos = undef; - while(my ($k, $v) = each %index) { - if (int($k) eq $k) { - my ($p, $line, $subject, $from, $mid)= - split(/\0/, $v); - if ($mid eq $wantmid) { - # Found it! - $pos = $p; - $idx = $k; - $startline = $line; - last; + while(my ($k, $v) = each %index) { + if (int($k) eq $k) { + my ($p, $line, $subject, $from, $mid)= + split(/\0/, $v); + $midmap{$mid} ||= [ $p, $k, $line ]; } } } + $pos = undef; + if ($midmap{$wantmid}) { + # Found it! + ($pos, $idx, $startline) = @{$midmap{$wantmid}}; + } } if (defined($pos)) { @@ -2128,6 +2127,8 @@ local ($file, $ids, $headersonly) = @_; local $retried = $_[3]; &mark_read_maildir($file); local @files = &get_maildir_files($file); +my $maps = &get_maildir_files_maps($file, \@files); + local @rv; local $missing; foreach my $i (@$ids) { @@ -2135,10 +2136,15 @@ foreach my $i (@$ids) { local $mail = &read_mail_file($path, $headersonly); if (!$mail && $path =~ /^(.*)\/(cur|tmp|new)\/([^:]*)(:2,([A-Za-z]*))?$/) { # Flag may have changed - update path - local $suffix = "$2/$3"; - local ($newfile) = grep - { substr($_, length($file)+1, length($suffix)) eq $suffix } - @files; + my $base = "$1/$2/$3"; + if (!$maps->{'base'}) { + foreach my $f (@files) { + my $fb = $f; + $fb =~ s/:2,[A-Za-z]*$//; + $maps->{'base'}->{$fb} ||= $f; + } + } + local $newfile = $maps->{'base'}->{$base}; if ($newfile) { $path = $newfile; $mail = &read_mail_file($path, $headersonly); @@ -2154,7 +2160,8 @@ foreach my $i (@$ids) { $mail->{'id'} = $path; $mail->{'id'} = substr($mail->{'id'}, length($file)+1); # Get index in directory - $mail->{'idx'} = &indexof($path, @files); + my $idx = $maps->{'idx'}->{$path}; + $mail->{'idx'} = defined($idx) ? $idx : -1; } else { $missing = 1; @@ -2168,6 +2175,27 @@ if ($missing && !$retried) { return @rv; } +# get_maildir_files_maps(directory, &files) +# Returns a hash ref containing a map from the paths of files in a Maildir to +# their indexes, so that lookups don't need to scan the whole list. A map from +# paths without flags to current paths is added by the caller if needed. The +# maps are re-used until the cached list of files changes. +sub get_maildir_files_maps +{ +my ($dir, $files) = @_; +my $cache = $main::list_maildir_cache{$dir}; +my $maps = $main::list_maildir_maps{$dir}; +if (!$maps || !$cache || $maps->{'cache'} ne $cache) { + my %idx; + for(my $i=0; $i<@$files; $i++) { + $idx{$files->[$i]} = $i; + } + $maps = { 'idx' => \%idx, 'cache' => $cache }; + $main::list_maildir_maps{$dir} = $maps if ($cache); + } +return $maps; +} + # Get ordered list of message files (with in-memory and on-disk caching, as # this can be slow) # get_maildir_files(directory) @@ -2199,7 +2227,6 @@ else { push(@files, $_[0]."/".$_); } close(CACHE); - $main::list_maildir_cache_time{$_[0]} = $cst[9]; } else { # Really read @@ -2261,9 +2288,9 @@ else { undef, $cachefile); } } - $main::list_maildir_cache_time{$_[0]} = $st[9]; } $main::list_maildir_cache{$_[0]} = \@files; + $main::list_maildir_cache_time{$_[0]} = $newest; } return @files; } @@ -2301,37 +2328,90 @@ sub mark_read_maildir local ($dir) = @_; local @files = &get_maildir_files($dir); local $i = 0; +local $changed = 0; +local $stale = 0; foreach my $nf (@files) { if (substr($nf, length($dir)+1, 3) eq "new") { local $cf = $nf; - $cf =~ s/\/new\//\/cur\//g; - if (&rename_as_mail_user($nf, $cf)) { + $cf =~ s/\/new\/([^\/]+)$/\/cur\/$1/; + if (!-e $nf) { + # Already moved or deleted by another process, so the + # cached file list is out of date. Don't try to rename, + # as rename_file would fall back to running mv + $stale = 1; + } + elsif (&rename_as_mail_user($nf, $cf)) { $files[$i] = $cf; $changed = 1; } } $i++; } -if ($changed) { - # Update the cache - $main::list_maildir_cache{$dir} = \@files; - local $cachefile = &get_maildir_cachefile($dir); - if ($cachefile) { - &open_tempfile(CACHE, ">$cachefile", 1); - foreach my $f (@files) { - local $short = substr($f, length($dir)+1); - &print_tempfile(CACHE, $short,"\n"); - } - &close_tempfile(CACHE); - local @st = stat($_[0]); - if ($< == 0) { - &set_ownership_permissions($st[4], $st[5], - undef, $cachefile); - } +if ($stale) { + # Force a re-read of the directory next time + &flush_maildir_cachefile($dir); + } +elsif ($changed) { + &save_maildir_cachefile($dir, \@files); + } +} + +# save_maildir_cachefile(dir, &files) +# Updates the in-memory and on-disk caches of files in a Maildir after this +# process has renamed some of them, including the new directory modification +# time so that the caches remain valid +sub save_maildir_cachefile +{ +my ($dir, $files) = @_; +my $newest; +foreach my $d ("$dir/cur", "$dir/new") { + my @dst = stat($d); + $newest = $dst[9] if ($dst[9] > $newest); + } +$main::list_maildir_cache{$dir} = $files; +$main::list_maildir_cache_time{$dir} = $newest; +my $cachefile = &get_maildir_cachefile($dir); +if ($cachefile) { + &open_tempfile(CACHE, ">$cachefile", 1); + foreach my $f (@$files) { + my $short = substr($f, length($dir)+1); + &print_tempfile(CACHE, $short,"\n"); + } + &close_tempfile(CACHE); + my @st = stat($dir); + if ($< == 0) { + &set_ownership_permissions($st[4], $st[5], undef, $cachefile); } } } +# rename_maildir_cachefile(dir, old-path, new-path) +# Updates the caches of files in a Maildir after one is renamed by this +# process, such as when its flags change. Returns 1 if the caches were up to +# date and could be updated, or 0 if they were flushed instead. +sub rename_maildir_cachefile +{ +my ($dir, $oldpath, $newpath) = @_; +my $cache = $main::list_maildir_cache{$dir}; +my $maps = $main::list_maildir_maps{$dir}; +my $i; +if ($cache && $maps && $maps->{'cache'} eq $cache) { + $i = $maps->{'idx'}->{$oldpath}; + } +elsif ($cache) { + $i = &indexof($oldpath, @$cache); + $i = undef if ($i < 0); + } +if (!defined($i)) { + &flush_maildir_cachefile($dir); + return 0; + } +my @files = @$cache; +$files[$i] = $newpath; +&save_maildir_cachefile($dir, \@files); +return 1; +} + # delete_maildir(&mail, ...) # Delete messages from a maildir directory sub delete_maildir @@ -2376,6 +2456,10 @@ foreach $m (@_) { unlink($m->{'file'}); } +# Refresh file lists even when directory timestamps have not changed. +foreach my $dir (keys %dirs) { + &flush_maildir_cachefile($dir); + } } # modify_maildir(&oldmail, &newmail, textonly) @@ -2439,6 +2523,9 @@ if ($up2date && $cachefile) { push(@$lref, $mail->{'id'}); &flush_file_lines($cachefile); } + +# Refresh file lists even when directory timestamps have not changed. +&flush_maildir_cachefile($dir); } # unique_maildir_filename(dir) diff --git a/mailboxes/folders-lib.pl b/mailboxes/folders-lib.pl index fa7f12c64..cf00f9405 100755 --- a/mailboxes/folders-lib.pl +++ b/mailboxes/folders-lib.pl @@ -572,20 +572,22 @@ foreach my $mail (@mail) { return @mail; } -# mailbox_get_mail(&folder, id, headersonly) -# Convenience function to get a single mail by ID +# mailbox_get_mail(&folder, id, headersonly, [skip-sort-index]) +# Convenience function to get a single mail by ID. Unless skip-sort-index is +# set, the message's position in the sorted folder is also computed, which +# can be slow for large folders. sub mailbox_get_mail { -local ($folder, $id, $headersonly) = @_; +local ($folder, $id, $headersonly, $nosortidx) = @_; local ($mail) = &mailbox_select_mails($folder, [ $id ], $headersonly); -if ($mail) { +if ($mail && !$nosortidx) { # Find the sort index for this message local ($field, $dir) = &get_sort_field($folder); if (!$field || !$folder->{'sortable'}) { # No sorting, so sort index is the opposite of real $mail->{'sortidx'} = &mailbox_folder_size($folder, 1) - $mail->{'idx'} - 1; - print DEBUG "idx=$mail->{'idx'} sortidx=$mail->{'sortidx'} size=",&mailbox_folder_size($folder, 1),"\n"; + print DEBUG "idx=$mail->{'idx'} sortidx=$mail->{'sortidx'}\n"; } else { # Need to extract from sort index @@ -643,10 +645,20 @@ elsif ($folder->{'type'} == 4) { return () if (!$count); $folder->{'lastchange'} = $rv[3] if ($rv[3]); - @rv = &imap_command($h, "FETCH 1:$count UID"); - foreach my $uid (@{$rv[1]}) { - if ($uid =~ /UID\s+(\d+)/) { - push(@idlist, $1); + # UID SEARCH returns all UIDs on one line, which is much faster to + # read than one FETCH response per message + @rv = &imap_command($h, "UID SEARCH ALL"); + if ($rv[0]) { + local ($srch) = grep { $_ =~ /^\*\s+SEARCH/i } @{$rv[1]}; + $srch =~ s/^\*\s+SEARCH\s*//i; + @idlist = sort { $a <=> $b } grep { /^\d+$/ } split(/\s+/, $srch); + } + else { + @rv = &imap_command($h, "FETCH 1:$count UID"); + foreach my $uid (@{$rv[1]}) { + if ($uid =~ /UID\s+(\d+)/) { + push(@idlist, $1); + } } } } @@ -778,15 +790,41 @@ local ($folder, $field, $dir) = @_; # Build or update the sort index. This is a file mapping unique IDs and fields # to sortable values. local %index; -&build_new_sort_index($folder, $field, \%index); +&build_new_sort_index($folder, $field, \%index) || return ( ); -# Get message indexes, sorted by the field +# Re-use the sorted list if already built by this process, and the index +# hasn't changed since +local $ifile = &folder_new_sort_index_file($folder); +my $memo = $main::sorted_ids_cache{$ifile}; +if ($memo && $memo->{'field'} eq $field && $memo->{'dir'} eq $dir) { + return @{$memo->{'ids'}}; + } + +# Get message indexes and the values of the field. If the list of IDs in the +# index is known, fetch each value directly as this is much faster than +# iterating over the whole DBM. my @sorter; -while(my ($k, $v) = each %index) { - if ($k =~ /^(.*)_\Q$field\E$/) { - push(@sorter, [ $1, lc($v) ]); +my $ids = &read_sort_index_ids($ifile, \%index); +if ($ids) { + foreach my $id (@$ids) { + my $v = $index{$id."_".$field}; + push(@sorter, [ $id, lc($v) ]) if (defined($v)); } } +else { + # Upgrade an existing index without rereading message headers. Save all + # IDs, including messages that lack the requested sort field. + my @ids; + while(my ($k, $v) = each %index) { + push(@ids, $1) if ($k =~ /^(.*)_size$/); + if ($k =~ /^(.*)_\Q$field\E$/) { + push(@sorter, [ $1, lc($v) ]); + } + } + &write_sort_index_ids($ifile, \%index, \@ids); + } + +# Sort by the field if ($field eq "size" || $field eq "date" || $field eq "x-spam-status") { # Numeric sort @sorter = sort { my $s = $a->[1] <=> $b->[1]; $dir ? $s : -$s } @sorter; @@ -795,7 +833,47 @@ else { # Alpha sort @sorter = sort { my $s = $a->[1] cmp $b->[1]; $dir ? $s : -$s } @sorter; } -return map { $_->[0] } @sorter; +my @rv = map { $_->[0] } @sorter; +$main::sorted_ids_cache{$ifile} = { 'field' => $field, 'dir' => $dir, + 'ids' => \@rv }; +return @rv; +} + +# read_sort_index_ids(index-file, &index) +# Returns an array ref of message IDs in a sort index, from the list saved +# alongside it, or undef if the list is missing or out of date +sub read_sort_index_ids +{ +my ($ifile, $index) = @_; +my $fh; +open($fh, "<", "$ifile.ids") || return undef; +my $hdr = <$fh>; +chomp($hdr); +if ($hdr ne $index->{'lastchange'}." ".$index->{'mailcount'}) { + close($fh); + return undef; + } +my @ids = <$fh>; +close($fh); +chomp(@ids); +return \@ids; +} + +# write_sort_index_ids(index-file, &index, &ids) +# Saves the list of message IDs in a sort index, along with its last update +# time and message count so that it can be checked for validity +sub write_sort_index_ids +{ +my ($ifile, $index, $ids) = @_; +my $fh = "IDSFILE"; +&open_tempfile($fh, ">$ifile.ids", 1) || return 0; +&print_tempfile($fh, $index->{'lastchange'}." ".$index->{'mailcount'}."\n"); +foreach my $id (@$ids) { + &print_tempfile($fh, $id."\n"); + } +my $ok = &close_tempfile($fh); +chmod(0600, "$ifile.ids"); +return $ok; } # delete_old_sort_index(&folder) @@ -826,7 +904,8 @@ local $ifile = &folder_new_sort_index_file($folder); &open_dbm_db($index, $ifile, 0600); print DEBUG "indexchange=$index->{'lastchange'} folderchange=$folder->{'lastchange'}\n"; -if ($index->{'lastchange'} != $folder->{'lastchange'} || +if ($index->{'recheck'} || + $index->{'lastchange'} != $folder->{'lastchange'} || !$folder->{'lastchange'} || (defined($folder->{'mailcount'}) && $index->{'mailcount'} != $folder->{'mailcount'})) { @@ -880,24 +959,41 @@ if ($index->{'lastchange'} != $folder->{'lastchange'} || } print DEBUG "added ",scalar(@mails)," messages to index\n"; - # Remove IDs that no longer exist + # Remove IDs that no longer exist. If the list of IDs previously in + # the index is known, just delete their entries, rather than + # iterating over the whole DBM to find them. local %ids = map { $_, 1 } (@ids, @wantids); local $dc = 0; - local @todelete; - while(my ($k, $v) = each %$index) { - if ($k =~ /^(.*)_([^_]+)$/ && !$ids{$1}) { - push(@todelete, $k); - $dc++ if ($2 eq "size"); + my $oldids = &read_sort_index_ids($ifile, $index); + if ($oldids) { + foreach my $id (@$oldids) { + next if ($ids{$id}); + foreach my $f (@index_fields) { + delete($index->{$id."_".$f}); + } + $dc++; } } - foreach my $k (@todelete) { - delete($index->{$k}); + else { + local @todelete; + while(my ($k, $v) = each %$index) { + if ($k =~ /^(.*)_([^_]+)$/ && !$ids{$1}) { + push(@todelete, $k); + $dc++ if ($2 eq "size"); + } + } + foreach my $k (@todelete) { + delete($index->{$k}); + } } print DEBUG "deleted $dc messages from index\n"; - # Record index update time + # Record index update time, and the IDs now in it $index->{'lastchange'} = $folder->{'lastchange'} || time(); $index->{'mailcount'} = scalar(@ids); + &write_sort_index_ids($ifile, $index, [ &unique(@ids, @wantids) ]); + delete($index->{'recheck'}); + delete($main::sorted_ids_cache{$ifile}); print DEBUG "new indexchange=$index->{'lastchange'}\n"; } return 1; @@ -914,6 +1010,7 @@ foreach my $field (@index_fields) { delete($index{$id."_".$field}); } dbmclose(%index); +delete($main::sorted_ids_cache{&folder_new_sort_index_file($folder)}); if ($folder->{'type'} == 5 || $folder->{'type'} == 6) { # Remove from underlying folder's index too local ($sfn, $sid) = split(/\t+/, $id, 2); @@ -933,6 +1030,33 @@ local %index; &build_new_sort_index($folder, undef, \%index); $index{'lastchange'} = 0; dbmclose(%index); +delete($main::sorted_ids_cache{&folder_new_sort_index_file($folder)}); +} + +# rename_new_sort_index_message(&folder, old-id, new-id) +# Updates a sort index after a message's ID changes, such as when the flags in +# a Maildir filename change, so that it doesn't need to be re-read +sub rename_new_sort_index_message +{ +my ($folder, $oldid, $newid) = @_; +return 0 if (!$folder->{'sortable'}); +my $ifile = &folder_new_sort_index_file($folder); +my %index; +&open_dbm_db(\%index, $ifile, 0600); +if (defined($index{$oldid."_size"})) { + foreach my $f (@index_fields) { + $index{$newid."_".$f} = $index{$oldid."_".$f}; + delete($index{$oldid."_".$f}); + } + } +# Refresh the ID lists once on their next use. Keep the old .ids file so +# the refresh can find removed IDs without scanning every DBM field. +$index{'recheck'} = 1; +dbmclose(%index); + +# Do not scan or rewrite a mailbox-sized list for each changed message. +delete($main::sorted_ids_cache{$ifile}); +return 1; } # delete_new_sort_index(&folder) @@ -945,6 +1069,9 @@ local $ifile = &folder_new_sort_index_file($folder); my %index; &open_dbm_db(\%index, $ifile, 0600); %index = ( ); +dbmclose(%index); +unlink("$ifile.ids"); +delete($main::sorted_ids_cache{$ifile}); } # folder_sort_index_file(&folder) @@ -1853,7 +1980,7 @@ elsif ($f->{'type'} == 6 && !$est) { # exist in the parent folders $rv = 0; foreach my $msg (@{$f->{'members'}}) { - if (&mailbox_get_mail($msg->[0], $msg->[1])) { + if (&mailbox_get_mail($msg->[0], $msg->[1], 1, 1)) { $rv++; } } @@ -1904,12 +2031,19 @@ elsif ($folder->{'type'} == 5) { } else { # For all other folders, just check individual messages - # XXX faster for maildir? local @data = ( 0, 0, 0 ); local @mails; eval { $main::error_must_die = 1; - @mails = &mailbox_list_mails(undef, undef, $folder, 1); + if ($folder->{'type'} == 1 && $folder->{'flags'}) { + # For a Maildir where read flags come from filenames, + # only read the headers of messages with no flags set, + # as only they need the read DBM checked + @mails = &list_maildir_flags($folder); + } + else { + @mails = &mailbox_list_mails(undef, undef, $folder, 1); + } }; return ( ) if ($@); foreach my $m (@mails) { @@ -1926,7 +2060,37 @@ else { } } -# mailbox_set_read_flags(&folder, &mail, read, special, replied) +# list_maildir_flags(&folder) +# Returns messages in a Maildir folder with IDs and flags taken from their +# filenames. Headers are only read for messages with no flags. +sub list_maildir_flags +{ +my ($folder) = @_; +my $md = $folder->{'file'}; +my @rv; +&switch_to_folder_user($folder); +&mark_read_maildir($md); +foreach my $f (&get_maildir_files($md)) { + my $mail = { 'header' => { } }; + if ($f =~ /:2,([A-Za-z]*)$/) { + my @flags = split(//, $1); + $mail->{'read'} = &indexoflc("S", @flags) >= 0 ? 1 : 0; + $mail->{'special'} = &indexoflc("F", @flags) >= 0 ? 1 : 0; + $mail->{'replied'} = &indexoflc("R", @flags) >= 0 ? 1 : 0; + $mail->{'flags'} = 1; + } + if (!$mail->{'read'} && !$mail->{'special'} && !$mail->{'replied'}) { + $mail = &read_mail_file($f, 1) || next; + } + $mail->{'file'} = $f; + $mail->{'id'} = substr($f, length($md)+1); + push(@rv, $mail); + } +&switch_from_folder_user($folder); +return @rv; +} + +# mailbox_set_read_flag(&folder, &mail, read, special, [replied]) # Updates the status flags on some message sub mailbox_set_read_flag { @@ -1970,11 +2134,22 @@ elsif ($folder->{'type'} == 1) { my $newfile = $base.":2,". join("", grep { $flags{$_} } sort(keys %flags)); if ($newfile ne $file) { - # Need to rename file - rename("$path$file", "$path$newfile"); + # Leave the message and sort index unchanged if the rename fails. + if (!rename("$path$file", "$path$newfile")) { + my $err = "$!"; + &flush_maildir_cachefile($folder->{'file'}); + &error("Failed to rename $path$file to $path$newfile : $err"); + } + + # Re-read the file list once on its next use. A delivery may have + # occurred during the rename, so the earlier snapshot is not safe. + &flush_maildir_cachefile($folder->{'file'}); + my $oldid = $mail->{'id'}; + $mail->{'file'} = "$path$newfile" if ($mail->{'file'}); $newfile =~ s/^(.*)\/((cur|tmp|new)\/.*)$/$2/; $mail->{'id'} = $newfile; - &flush_maildir_cachefile($folder->{'file'}); + &rename_new_sort_index_message($folder, $oldid, $newfile) + if ($oldid ne $newfile); } } else { diff --git a/mailboxes/mailboxes-lib.pl b/mailboxes/mailboxes-lib.pl index 2dc0ddb48..b07c87de0 100755 --- a/mailboxes/mailboxes-lib.pl +++ b/mailboxes/mailboxes-lib.pl @@ -1143,6 +1143,7 @@ foreach my $folder (&list_user_folders($user)) { else { &unlink_file(glob("\Q$ifile\E.{dir,pag,db}")); } + &unlink_file("$ifile.ids") if (-e "$ifile.ids"); } # Remove read file local $read = &user_read_dbm_file($user); diff --git a/mailboxes/t/maildir-cache.t b/mailboxes/t/maildir-cache.t new file mode 100644 index 000000000..94e79778c --- /dev/null +++ b/mailboxes/t/maildir-cache.t @@ -0,0 +1,201 @@ +#!/usr/bin/perl +use strict; +use warnings; +use Test::More; +use Cwd qw(abs_path); +use File::Basename qw(dirname); +use File::Path qw(make_path); +use File::Temp qw(tempdir); + +# Inject delivery immediately before a real rename without replacing its result. +our $before_rename; +BEGIN { + *CORE::GLOBAL::rename = sub { + if ($before_rename) { + my $callback = $before_rename; + $before_rename = undef; + $callback->(@_); + } + return CORE::rename($_[0], $_[1]); + }; + } + +# An optional source root allows the same cases to run against the original PR. +my $root = abs_path(shift(@ARGV) || dirname(__FILE__)."/../.."); +my $tmp = tempdir(CLEANUP => 1); +our ($root_directory, $config_directory, $var_directory, + $module_config_directory, $user_module_config_directory, + $module_var_directory, $done_web_lib_funcs, $error_must_die, + %config, %gconfig, %sorted_ids_cache, $null_file); +$root_directory = $root; +$config_directory = "$tmp/config"; +$var_directory = "$tmp/var"; +$module_config_directory = $user_module_config_directory = "$tmp/config/mailbox"; +$module_var_directory = "$tmp/var/mailbox"; +make_path($module_config_directory, $module_var_directory); +$error_must_die = 1; +$null_file = "/dev/null"; +%config = (noindex_hostname => 1); +%gconfig = (product => 'usermin'); +require "$root/web-lib-funcs.pl"; +$done_web_lib_funcs = 1; +require "$root/web-lib.pl"; +require "$root/mailboxes/boxes-lib.pl"; +require "$root/mailboxes/folders-lib.pl"; + +# message(path, subject) writes a small, complete fixture message. +sub message +{ +my ($path, $subject) = @_; +open(my $fh, '>', $path) or die "$path: $!"; +print $fh "From: a\@example.test\nTo: b\@example.test\n", + "Subject: $subject\nMessage-ID: <$subject\@example.test>\n", + "Date: Tue, 27 Oct 2026 12:00:00 +0000\n\nbody\n"; +close($fh) or die "$path: $!"; +} + +# folder(name, count) creates a separate Maildir with unread messages. +sub folder +{ +my ($name, $count) = @_; +my $dir = "$tmp/$name/Maildir"; +make_path(map { "$dir/$_" } qw(cur new tmp)); +foreach my $i (1..$count) { + message("$dir/cur/msg$i:2,", "message$i"); + } +my $folder = { type => 1, file => $dir, sortable => 1, flags => 2 }; +$folder->{'lastchange'} = modification_time($folder); +return $folder; +} + +subtest 'writes and deletes refresh the file list within one timestamp tick' => sub { + foreach my $operation ('write', 'delete') { + my $folder = folder($operation, 2); + my $dir = $folder->{'file'}; + my @dirs = ("$dir/cur", "$dir/new"); + my $stamp = time() - 5; + utime($stamp, $stamp, @dirs) == 2 or die $!; + my @expected = get_maildir_files($dir); + my $mail = read_mail_file("$dir/cur/msg2:2,"); + if ($operation eq 'write') { + # Add a real message through the folder API. + write_mail_folder($mail, $folder, 0); + push(@expected, $mail->{'file'}); + } + else { + # Remove a real message through the folder API. + $mail->{'id'} = 'cur/msg2:2,'; + mailbox_delete_mail($folder, $mail); + @expected = grep { $_ ne $mail->{'file'} } @expected; + } + # Keep mtimes equal to simulate changes within the same second. + utime($stamp, $stamp, @dirs) == 2 or die $!; + is_deeply([sort(get_maildir_files($dir))], [sort(@expected)], + "$operation is visible without a directory timestamp change"); + } + }; + +subtest 'delivery during a flag rename is not hidden' => sub { + my $folder = folder('delivery', 1); + my $dir = $folder->{'file'}; + my ($mail) = select_maildir($dir, ['cur/msg1:2,'], 1); + local $before_rename = sub { message("$dir/new/delivered", 'delivered'); }; + mailbox_set_read_flag($folder, $mail, 1, 0, 0); + is_deeply([sort(get_maildir_files($dir))], + ["$dir/cur/msg1:2,S", "$dir/new/delivered"], + 'both the renamed message and concurrent delivery are visible'); + }; + +subtest 'failed rename preserves the mail object and sort index' => sub { + my $folder = folder('failed-rename', 1); + my $dir = $folder->{'file'}; + my @before = build_sorted_ids($folder, 'subject', 1); + my ($mail) = select_maildir($dir, ['cur/msg1:2,'], 1); + my %original = %$mail; + # A file cannot replace a directory, even when the test runs as root. + mkdir("$dir/cur/msg1:2,S") or die $!; + my $ok = eval { mailbox_set_read_flag($folder, $mail, 1, 0, 0); 1 }; + ok(!$ok, 'failure is reported to the caller'); + like($@, qr/Failed to rename/, 'error identifies the failed operation'); + ok(-f "$dir/cur/msg1:2,", 'original message still exists'); + is_deeply($mail, \%original, 'mail object is unchanged'); + is_deeply([build_sorted_ids($folder, 'subject', 1)], \@before, + 'sort index retains the original ID'); + my %index; + open_dbm_db(\%index, folder_new_sort_index_file($folder), 0600); + ok(defined($index{'cur/msg1:2,_size'}), 'original DBM entry remains'); + ok(!defined($index{'cur/msg1:2,S_size'}), 'no DBM entry for a failed rename'); + dbmclose(%index); + }; + +subtest 'existing indexes gain a missing ids file without reading messages' => sub { + my $folder = folder('upgrade', 3); + my @before = build_sorted_ids($folder, 'subject', 1); + my $ifile = folder_new_sort_index_file($folder); + unlink("$ifile.ids") or die $!; + delete($main::sorted_ids_cache{$ifile}); + my $reads = 0; + my $reader = \&read_mail_file; + { + no warnings 'redefine'; + local *main::read_mail_file = sub { $reads++; return &$reader(@_); }; + is_deeply([build_sorted_ids($folder, 'subject', 1)], \@before, + 'unchanged index still sorts correctly'); + } + is($reads, 0, 'migration reads the index, not the messages'); + ok(-s "$ifile.ids", 'sidecar is persisted for subsequent requests'); + my %index; + open_dbm_db(\%index, $ifile, 0600); + my $ids = read_sort_index_ids($ifile, \%index); + is_deeply([sort(@{$ids || []})], [sort(@before)], 'sidecar contains every ID'); + dbmclose(%index); + }; + +subtest 'bulk flags avoid mailbox-sized work for each message' => sub { + my $folder = folder('bulk', 100); + my $dir = $folder->{'file'}; + my @before = build_sorted_ids($folder, 'subject', 1); + my $ifile = folder_new_sort_index_file($folder); + my $cachefile = get_maildir_cachefile($dir); + my @ids = map { "cur/msg$_:2," } 1..20; + my @mails = select_maildir($dir, \@ids, 1); + my ($writes, $lists) = (0, 0); + my $opener = \&open_tempfile; + my $lister = \&get_maildir_files; + { + no warnings 'redefine'; + local *main::open_tempfile = sub { + $writes++ if (defined($_[1]) && + ($_[1] eq ">$cachefile" || $_[1] eq ">$ifile.ids")); + return &$opener(@_); + }; + local *main::get_maildir_files = sub { $lists++; return &$lister(@_); }; + # Toggle both ways before sorting to check repeated pending renames. + foreach my $read (1, 0, 1) { + foreach my $mail (@mails) { + mailbox_set_read_flag($folder, $mail, $read, 0, 0); + } + } + } + is($writes, 0, 'batch does not rewrite whole cache files'); + is($lists, 0, 'batch does not fetch the entire file list per message'); + is(scalar(grep { -f "$dir/${_}S" } @ids), 20, 'all flag renames succeeded'); + my %changed = map { $_ => 1 } @ids; + my @expected = map { $changed{$_} ? $_.'S' : $_ } @before; + my $reads = 0; + my $reader = \&read_mail_file; + { + no warnings 'redefine'; + local *main::read_mail_file = sub { $reads++; return &$reader(@_); }; + is_deeply([build_sorted_ids($folder, 'subject', 1)], \@expected, + 'next sort uses the renamed IDs in the same order'); + } + is($reads, 0, 'renaming preserves the cached message headers'); + ok(-s "$ifile.ids", 'next sort recreates the sidecar'); + my %index; + open_dbm_db(\%index, $ifile, 0600); + ok(!$index{'recheck'}, 'refresh is not repeated on later requests'); + dbmclose(%index); + }; + +done_testing();