From 5e65ba0f0e7e23d44bd4c6663c7e4d93ce6c1104 Mon Sep 17 00:00:00 2001 From: Joe Cooper Date: Sun, 25 Oct 2026 14:15:18 -0500 Subject: [PATCH 1/7] Fix a variety of performance hotspots --- mailboxes/boxes-lib.pl | 57 ++++++++++++++++++++++++---------------- mailboxes/folders-lib.pl | 32 +++++++++++++++------- 2 files changed, 57 insertions(+), 32 deletions(-) diff --git a/mailboxes/boxes-lib.pl b/mailboxes/boxes-lib.pl index 167f695f4..44c1471f5 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,17 @@ local ($file, $ids, $headersonly) = @_; local $retried = $_[3]; &mark_read_maildir($file); local @files = &get_maildir_files($file); + +# Build maps from paths to directory indexes, and from paths without flags to +# current paths, so that each lookup doesn't need to scan the whole list +my (%fileidx, %basefile); +for(my $i=0; $i<@files; $i++) { + $fileidx{$files[$i]} = $i; + my $base = $files[$i]; + $base =~ s/:2,[A-Za-z]*$//; + $basefile{$base} ||= $files[$i]; + } + local @rv; local $missing; foreach my $i (@$ids) { @@ -2135,10 +2145,7 @@ 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; + local $newfile = $basefile{"$1/$2/$3"}; if ($newfile) { $path = $newfile; $mail = &read_mail_file($path, $headersonly); @@ -2154,7 +2161,7 @@ foreach my $i (@$ids) { $mail->{'id'} = $path; $mail->{'id'} = substr($mail->{'id'}, length($file)+1); # Get index in directory - $mail->{'idx'} = &indexof($path, @files); + $mail->{'idx'} = defined($fileidx{$path}) ? $fileidx{$path} : -1; } else { $missing = 1; @@ -2199,7 +2206,6 @@ else { push(@files, $_[0]."/".$_); } close(CACHE); - $main::list_maildir_cache_time{$_[0]} = $cst[9]; } else { # Really read @@ -2261,9 +2267,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,6 +2307,7 @@ sub mark_read_maildir local ($dir) = @_; local @files = &get_maildir_files($dir); local $i = 0; +local $changed = 0; foreach my $nf (@files) { if (substr($nf, length($dir)+1, 3) eq "new") { local $cf = $nf; @@ -2313,8 +2320,14 @@ foreach my $nf (@files) { $i++; } if ($changed) { - # Update the cache + # Update the cache, including the new directory modification time + local $newest; + foreach my $d ("$dir/cur", "$dir/new") { + local @dst = stat($d); + $newest = $dst[9] if ($dst[9] > $newest); + } $main::list_maildir_cache{$dir} = \@files; + $main::list_maildir_cache_time{$dir} = $newest; local $cachefile = &get_maildir_cachefile($dir); if ($cachefile) { &open_tempfile(CACHE, ">$cachefile", 1); diff --git a/mailboxes/folders-lib.pl b/mailboxes/folders-lib.pl index fa7f12c64..9ba98b3b1 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); + } } } } @@ -1853,7 +1865,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++; } } From a0aa10c479c6179e6d36f78d58d5f9182c34c044 Mon Sep 17 00:00:00 2001 From: Joe Cooper Date: Sun, 25 Oct 2026 15:14:45 -0500 Subject: [PATCH 2/7] Be more careful about falling back to spawning a new process for mv --- mailboxes/boxes-lib.pl | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/mailboxes/boxes-lib.pl b/mailboxes/boxes-lib.pl index 44c1471f5..2489a2f4f 100755 --- a/mailboxes/boxes-lib.pl +++ b/mailboxes/boxes-lib.pl @@ -2308,18 +2308,29 @@ 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) { +if ($stale) { + # Force a re-read of the directory next time + &flush_maildir_cachefile($dir); + } +elsif ($changed) { # Update the cache, including the new directory modification time local $newest; foreach my $d ("$dir/cur", "$dir/new") { From 863b442d9d812a99dcd3c730460c4ab0039aa725 Mon Sep 17 00:00:00 2001 From: Joe Cooper Date: Sun, 25 Oct 2026 15:35:10 -0500 Subject: [PATCH 3/7] Don't read every mail file on every page load --- mailboxes/folders-lib.pl | 41 ++++++++++++++++++++++++++++++++++++++-- 1 file changed, 39 insertions(+), 2 deletions(-) diff --git a/mailboxes/folders-lib.pl b/mailboxes/folders-lib.pl index 9ba98b3b1..91f4dc7d9 100755 --- a/mailboxes/folders-lib.pl +++ b/mailboxes/folders-lib.pl @@ -1916,12 +1916,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) { @@ -1938,6 +1945,36 @@ else { } } +# 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_flags(&folder, &mail, read, special, replied) # Updates the status flags on some message sub mailbox_set_read_flag From 8c5066fbccc5da287a29b88877e5b1de3af27c7d Mon Sep 17 00:00:00 2001 From: Joe Cooper Date: Sun, 25 Oct 2026 16:31:24 -0500 Subject: [PATCH 4/7] view_mail.cgi performance fixes --- mailboxes/boxes-lib.pl | 120 ++++++++++++++++++------- mailboxes/folders-lib.pl | 173 +++++++++++++++++++++++++++++++++---- mailboxes/mailboxes-lib.pl | 1 + 3 files changed, 244 insertions(+), 50 deletions(-) diff --git a/mailboxes/boxes-lib.pl b/mailboxes/boxes-lib.pl index 2489a2f4f..40c6190bd 100755 --- a/mailboxes/boxes-lib.pl +++ b/mailboxes/boxes-lib.pl @@ -2127,16 +2127,7 @@ local ($file, $ids, $headersonly) = @_; local $retried = $_[3]; &mark_read_maildir($file); local @files = &get_maildir_files($file); - -# Build maps from paths to directory indexes, and from paths without flags to -# current paths, so that each lookup doesn't need to scan the whole list -my (%fileidx, %basefile); -for(my $i=0; $i<@files; $i++) { - $fileidx{$files[$i]} = $i; - my $base = $files[$i]; - $base =~ s/:2,[A-Za-z]*$//; - $basefile{$base} ||= $files[$i]; - } +my $maps = &get_maildir_files_maps($file, \@files); local @rv; local $missing; @@ -2145,7 +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 $newfile = $basefile{"$1/$2/$3"}; + 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); @@ -2161,7 +2160,8 @@ foreach my $i (@$ids) { $mail->{'id'} = $path; $mail->{'id'} = substr($mail->{'id'}, length($file)+1); # Get index in directory - $mail->{'idx'} = defined($fileidx{$path}) ? $fileidx{$path} : -1; + my $idx = $maps->{'idx'}->{$path}; + $mail->{'idx'} = defined($idx) ? $idx : -1; } else { $missing = 1; @@ -2175,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) @@ -2331,31 +2352,66 @@ if ($stale) { &flush_maildir_cachefile($dir); } elsif ($changed) { - # Update the cache, including the new directory modification time - local $newest; - foreach my $d ("$dir/cur", "$dir/new") { - local @dst = stat($d); - $newest = $dst[9] if ($dst[9] > $newest); + &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"); } - $main::list_maildir_cache{$dir} = \@files; - $main::list_maildir_cache_time{$dir} = $newest; - 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); - } + &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 diff --git a/mailboxes/folders-lib.pl b/mailboxes/folders-lib.pl index 91f4dc7d9..98b93cdae 100755 --- a/mailboxes/folders-lib.pl +++ b/mailboxes/folders-lib.pl @@ -790,15 +790,36 @@ 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 { + while(my ($k, $v) = each %index) { + if ($k =~ /^(.*)_\Q$field\E$/) { + push(@sorter, [ $1, lc($v) ]); + } + } + } + +# 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; @@ -807,7 +828,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) @@ -892,24 +953,40 @@ 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($main::sorted_ids_cache{$ifile}); print DEBUG "new indexchange=$index->{'lastchange'}\n"; } return 1; @@ -926,6 +1003,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); @@ -945,6 +1023,50 @@ 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}); + } + my $ids = &read_sort_index_ids($ifile, \%index); + if ($ids) { + my $i = &indexof($oldid, @$ids); + if ($i >= 0) { + $ids->[$i] = $newid; + &write_sort_index_ids($ifile, \%index, $ids); + } + else { + unlink("$ifile.ids"); + } + } + } +dbmclose(%index); + +# Update the ID in any already-sorted list too, as its position is unchanged +my $memo = $main::sorted_ids_cache{$ifile}; +if ($memo) { + my $i = &indexof($oldid, @{$memo->{'ids'}}); + if ($i >= 0) { + $memo->{'ids'}->[$i] = $newid; + } + else { + delete($main::sorted_ids_cache{$ifile}); + } + } +return 1; } # delete_new_sort_index(&folder) @@ -957,6 +1079,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) @@ -2019,11 +2144,23 @@ 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"); + # Need to rename file. Make sure the cached list of files is + # current first, so that it can be updated rather than + # flushed, which would force a re-read of the whole directory + &get_maildir_files($folder->{'file'}); + my $oldid = $mail->{'id'}; + if (rename("$path$file", "$path$newfile")) { + &rename_maildir_cachefile($folder->{'file'}, + "$path$file", "$path$newfile"); + } + else { + &flush_maildir_cachefile($folder->{'file'}); + } + $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); From 63a4880d4352cc5e0c928653e49a39db58aa39c6 Mon Sep 17 00:00:00 2001 From: Ilia Ross Date: Tue, 27 Oct 2026 15:10:16 +0100 Subject: [PATCH 5/7] Fix bulk Maildir flag updates This patch fixes repeated cache rewrites when marking Maildir messages read or unread. It refreshes the lists on their next use, handles concurrent delivery safely, and preserves the index when renaming fails. --- mailboxes/folders-lib.pl | 52 +++++-------- mailboxes/t/maildir-cache.t | 151 ++++++++++++++++++++++++++++++++++++ 2 files changed, 169 insertions(+), 34 deletions(-) create mode 100644 mailboxes/t/maildir-cache.t diff --git a/mailboxes/folders-lib.pl b/mailboxes/folders-lib.pl index 98b93cdae..d7b200011 100755 --- a/mailboxes/folders-lib.pl +++ b/mailboxes/folders-lib.pl @@ -899,7 +899,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'})) { @@ -986,6 +987,7 @@ if ($index->{'lastchange'} != $folder->{'lastchange'} || $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"; } @@ -1041,31 +1043,14 @@ if (defined($index{$oldid."_size"})) { $index{$newid."_".$f} = $index{$oldid."_".$f}; delete($index{$oldid."_".$f}); } - my $ids = &read_sort_index_ids($ifile, \%index); - if ($ids) { - my $i = &indexof($oldid, @$ids); - if ($i >= 0) { - $ids->[$i] = $newid; - &write_sort_index_ids($ifile, \%index, $ids); - } - else { - unlink("$ifile.ids"); - } - } } +# 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); -# Update the ID in any already-sorted list too, as its position is unchanged -my $memo = $main::sorted_ids_cache{$ifile}; -if ($memo) { - my $i = &indexof($oldid, @{$memo->{'ids'}}); - if ($i >= 0) { - $memo->{'ids'}->[$i] = $newid; - } - else { - delete($main::sorted_ids_cache{$ifile}); - } - } +# Do not scan or rewrite a mailbox-sized list for each changed message. +delete($main::sorted_ids_cache{$ifile}); return 1; } @@ -2100,7 +2085,7 @@ foreach my $f (&get_maildir_files($md)) { return @rv; } -# mailbox_set_read_flags(&folder, &mail, read, special, replied) +# mailbox_set_read_flag(&folder, &mail, read, special, [replied]) # Updates the status flags on some message sub mailbox_set_read_flag { @@ -2144,18 +2129,17 @@ elsif ($folder->{'type'} == 1) { my $newfile = $base.":2,". join("", grep { $flags{$_} } sort(keys %flags)); if ($newfile ne $file) { - # Need to rename file. Make sure the cached list of files is - # current first, so that it can be updated rather than - # flushed, which would force a re-read of the whole directory - &get_maildir_files($folder->{'file'}); - my $oldid = $mail->{'id'}; - if (rename("$path$file", "$path$newfile")) { - &rename_maildir_cachefile($folder->{'file'}, - "$path$file", "$path$newfile"); - } - else { + # 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; diff --git a/mailboxes/t/maildir-cache.t b/mailboxes/t/maildir-cache.t new file mode 100644 index 000000000..abda1e5ec --- /dev/null +++ b/mailboxes/t/maildir-cache.t @@ -0,0 +1,151 @@ +#!/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 '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 '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(); From 91cad9d29a210c351a1d36dca1349804d6306939 Mon Sep 17 00:00:00 2001 From: Ilia Ross Date: Tue, 27 Oct 2026 15:12:40 +0100 Subject: [PATCH 6/7] Fix missing sort-index ID lists This patch fixes missing `.ids` files for existing sort indexes after an upgrade. It creates the ID list from the existing index without rereading messages. A regression test verifies that sorting stays correct and the missing file is created. --- mailboxes/folders-lib.pl | 5 +++++ mailboxes/t/maildir-cache.t | 23 +++++++++++++++++++++++ 2 files changed, 28 insertions(+) diff --git a/mailboxes/folders-lib.pl b/mailboxes/folders-lib.pl index d7b200011..cf00f9405 100755 --- a/mailboxes/folders-lib.pl +++ b/mailboxes/folders-lib.pl @@ -812,11 +812,16 @@ if ($ids) { } } 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 diff --git a/mailboxes/t/maildir-cache.t b/mailboxes/t/maildir-cache.t index abda1e5ec..f90597967 100644 --- a/mailboxes/t/maildir-cache.t +++ b/mailboxes/t/maildir-cache.t @@ -101,6 +101,29 @@ subtest 'failed rename preserves the mail object and sort index' => sub { 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'}; From 5d41784c9f5a1e2b1385bb9226974d1f67a1879e Mon Sep 17 00:00:00 2001 From: Ilia Ross Date: Tue, 27 Oct 2026 19:48:52 +0100 Subject: [PATCH 7/7] Fix Maildir cache invalidation after writes and deletes This patch fixes stale Maildir file lists after messages are added or deleted. It clears the caches so changes are visible even when directory timestamps remain within the same second. --- mailboxes/boxes-lib.pl | 7 +++++++ mailboxes/t/maildir-cache.t | 27 +++++++++++++++++++++++++++ 2 files changed, 34 insertions(+) diff --git a/mailboxes/boxes-lib.pl b/mailboxes/boxes-lib.pl index 40c6190bd..aeca28b7e 100755 --- a/mailboxes/boxes-lib.pl +++ b/mailboxes/boxes-lib.pl @@ -2456,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) @@ -2519,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/t/maildir-cache.t b/mailboxes/t/maildir-cache.t index f90597967..94e79778c 100644 --- a/mailboxes/t/maildir-cache.t +++ b/mailboxes/t/maildir-cache.t @@ -68,6 +68,33 @@ $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'};