mirror of
https://github.com/webmin/webmin.git
synced 2026-10-28 14:11:03 +00:00
Merge pull request #2902 from webmin/dev/mailboxes-performance-and-bugs
Fix a variety of performance hotspots
This commit is contained in:
Jamie Cameron
@@ -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)
|
||||
|
||||
@@ -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 {
|
||||
|
||||
@@ -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);
|
||||
|
||||
201
mailboxes/t/maildir-cache.t
Normal file
201
mailboxes/t/maildir-cache.t
Normal file
@@ -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();
|
||||
Reference in New Issue
Block a user