Compare commits

..

4 Commits

Author SHA1 Message Date
Joe Cooper
8c5066fbcc view_mail.cgi performance fixes 2026-10-25 16:31:24 -05:00
Joe Cooper
863b442d9d Don't read every mail file on every page load 2026-10-25 15:35:10 -05:00
Joe Cooper
a0aa10c479 Be more careful about falling back to spawning a new process for mv 2026-10-25 15:14:45 -05:00
Joe Cooper
5e65ba0f0e Fix a variety of performance hotspots 2026-10-25 14:15:18 -05:00
4 changed files with 349 additions and 89 deletions

View File

@@ -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

View File

@@ -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,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;
@@ -795,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)
@@ -880,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;
@@ -914,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);
@@ -933,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)
@@ -945,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)
@@ -1853,7 +1990,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 +2041,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,6 +2070,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
@@ -1970,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 {

View File

@@ -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);

View File

@@ -789,27 +789,21 @@ sub regenerate_dependent_table
#
sub regenerate_any_table
{
my ($name, $force, $after, $base64) = @_;
$base64 = 0 if (&compare_version_numbers($postfix_version, 3.4) < 0);
my @files;
if ($force) {
my ($name, $force, $after, $base64) = @_;
$base64 = 0 if (&compare_version_numbers($postfix_version, 3.4) < 0);
my @files;
if ($force) {
@files = map { [ "hash", $_ ] } @$force;
}
elsif (&get_current_value($name) ne "") {
} elsif (&get_current_value($name) ne "") {
my $value = &get_real_value($name);
if ($after) {
$value =~ s/^.*\Q$after\E\s+(\S+).*$/$1/ || return;
}
@files = &get_maps_types_files($value);
}
foreach my $map (@files) {
next unless $map;
# Make safe permissions for SNI maps
if ($name eq "tls_server_sni_maps" && &file_map_type($map->[0])) {
&set_ownership_permissions(undef, undef, 0600, $map->[1],
glob("$map->[1].*"));
}
}
foreach my $map (@files)
{
next unless $map;
# Text maps are read directly by Postfix and cannot be indexed.
if (&file_map_type($map->[0]) &&
$map->[0] ne 'regexp' && $map->[0] ne 'pcre' &&
@@ -820,11 +814,12 @@ foreach my $map (@files) {
($base64 ? " -F" : "").
" $map->[0]:$map->[1] 2>&1");
if ($?) { &error(&text('regenerate_table_efailed', $map->[1], $out)); }
}
}
}
}
############################################################################
# maps [canonical, virtual, transport] support
@@ -1658,15 +1653,13 @@ return $v;
# Create some map text file, if needed
sub ensure_map
{
my ($name) = @_;
my $perms = $name eq "tls_server_sni_maps" ? 0600 : 0755;
foreach my $mf (&get_maps_files(&get_real_value($name))) {
foreach my $mf (&get_maps_files(&get_real_value($_[0]))) {
if ($mf =~ /^\// && !-e $mf) {
my $touchfh = "TOUCH";
&open_lock_tempfile($touchfh, ">$mf", 1) ||
&error(&text("efilewrite", $mf, $!));
&close_tempfile($touchfh);
&set_ownership_permissions(undef, undef, $perms, $mf);
&set_ownership_permissions(undef, undef, 0755, $mf);
}
}
}