/mailboxes/folders-lib.pl
Perl | 3608 lines | 2953 code | 170 blank | 485 comment | 764 complexity | 01d8c9b3b1d14d869a04deec4830094c MD5 | raw file
Possible License(s): BSD-3-Clause, CC-BY-SA-3.0
Large files files are truncated, but you can click here to view the full file
- # folders-lib.pl
- # Functions for dealing with mail folders in various formats
- $pop3_port = 110;
- $imap_port = 143;
- $cache_directory = $user_module_config_directory || $module_config_directory;
- @index_fields = ( "subject", "from", "to", "date", "size",
- "x-spam-status", "message-id" );
- $create_cid_count = 0;
- # mailbox_list_mails(start, end, &folder, [headersonly], [&error])
- # Returns an array whose size is that of the entire folder, with messages
- # in the specified range filled in.
- sub mailbox_list_mails
- {
- if ($_[2]->{'type'} == 0) {
- # List a single mbox formatted file
- return &list_mails($_[2]->{'file'}, $_[0], $_[1]);
- }
- elsif ($_[2]->{'type'} == 1) {
- # List a qmail maildir
- local $md = $_[2]->{'file'};
- return &list_maildir($md, $_[0], $_[1], $_[3]);
- }
- elsif ($_[2]->{'type'} == 2) {
- # Get mail headers/body from a remote POP3 server
- # Login first
- local @rv = &pop3_login($_[2]);
- if ($rv[0] != 1) {
- # Failed to connect or login
- if ($_[4]) {
- @{$_[4]} = @rv;
- return ();
- }
- elsif ($rv[0] == 0) { &error($rv[1]); }
- else { &error(&text('save_elogin', $rv[1])); }
- }
- local $h = $rv[1];
- local @uidl = &pop3_uidl($h);
- local %onserver = map { &safe_uidl($_), 1 } @uidl;
- # Work out what range we want
- local ($start, $end) = &compute_start_end($_[0], $_[1], scalar(@uidl));
- local @rv = map { undef } @uidl;
- # For each message in the range, get the headers or body
- local ($i, $f, %cached, %sizeneed);
- local $cd = "$cache_directory/$_[2]->{'id'}.cache";
- if (opendir(CACHE, $cd)) {
- while($f = readdir(CACHE)) {
- if ($f =~ /^(\S+)\.body$/) {
- $cached{$1} = 2;
- }
- elsif ($f =~ /^(\S+)\.headers$/) {
- $cached{$1} = 1;
- }
- }
- closedir(CACHE);
- }
- else {
- mkdir($cd, 0700);
- }
- for($i=$start; $i<=$end; $i++) {
- local $u = &safe_uidl($uidl[$i]);
- if ($cached{$u} == 2 || $cached{$u} == 1 && $_[3]) {
- # We already have everything that we need
- }
- elsif ($cached{$u} == 1 || !$_[3]) {
- # We need to get the entire mail
- &pop3_command($h, "retr ".($i+1));
- open(CACHE, ">$cd/$u.body");
- while(<$h>) {
- s/\r//g;
- last if ($_ eq ".\n");
- print CACHE $_;
- }
- close(CACHE);
- unlink("$cd/$u.headers");
- $cached{$u} = 2;
- }
- else {
- # We just need the headers
- &pop3_command($h, "top ".($i+1)." 0");
- open(CACHE, ">$cd/$u.headers");
- while(<$h>) {
- s/\r//g;
- last if ($_ eq ".\n");
- print CACHE $_;
- }
- close(CACHE);
- $cached{$u} = 1;
- }
- local $mail = &read_mail_file($cached{$u} == 2 ?
- "$cd/$u.body" : "$cd/$u.headers");
- if ($cached{$u} == 1) {
- if ($mail->{'body'} ne "") {
- $mail->{'size'} = int($mail->{'body'});
- }
- else {
- $sizeneed{$i} = 1;
- }
- }
- $mail->{'idx'} = $i;
- $mail->{'id'} = $uidl[$i];
- $rv[$i] = $mail;
- }
- # Get sizes for mails if needed
- if (%sizeneed) {
- &pop3_command($h, "list");
- while(<$h>) {
- s/\r//g;
- last if ($_ eq ".\n");
- if (/^(\d+)\s+(\d+)/ && $sizeneed{$1-1}) {
- # Add size to the mail cache
- $rv[$1-1]->{'size'} = $2;
- local $u = &safe_uidl($uidl[$1-1]);
- open(CACHE, ">>$cd/$u.headers");
- print CACHE $2,"\n";
- close(CACHE);
- }
- }
- }
- # Clean up any cached mails that no longer exist on the server
- foreach $f (keys %cached) {
- if (!$onserver{$f}) {
- unlink($cached{$f} == 1 ? "$cd/$f.headers"
- : "$cd/$f.body");
- }
- }
- return @rv;
- }
- elsif ($_[2]->{'type'} == 3) {
- # List an MH directory
- local $md = $_[2]->{'file'};
- return &list_mhdir($md, $_[0], $_[1], $_[3]);
- }
- elsif ($_[2]->{'type'} == 4) {
- # Get headers and possibly bodies from an IMAP server
- # Login and select the specified mailbox
- local @rv = &imap_login($_[2]);
- if ($rv[0] != 1) {
- # Something went wrong
- if ($_[4]) {
- @{$_[4]} = @rv;
- return ();
- }
- elsif ($rv[0] == 0) { &error($rv[1]); }
- elsif ($rv[0] == 3) { &error(&text('save_emailbox', $rv[1])); }
- elsif ($rv[0] == 2) { &error(&text('save_elogin2', $rv[1])); }
- }
- local $h = $rv[1];
- local $count = $rv[2];
- return () if (!$count);
- $_[2]->{'lastchange'} = $rv[3] if ($rv[3]);
- # Work out what range we want
- local ($start, $end) = &compute_start_end($_[0], $_[1], $count);
- local @mail = map { undef } (0 .. $count-1);
- # Get the headers or body of messages in the specified range
- local @rv;
- if ($_[3]) {
- # Just the headers
- @rv = &imap_command($h,
- sprintf "FETCH %d:%d (RFC822.SIZE UID FLAGS RFC822.HEADER)",
- $start+1, $end+1);
- }
- else {
- # Whole messages
- @rv = &imap_command($h,
- sprintf "FETCH %d:%d (UID FLAGS BODY.PEEK[])", $start+1, $end+1);
- }
- # Parse the headers or whole messages that came back
- local $i;
- for($i=0; $i<@{$rv[1]}; $i++) {
- # Extract the actual mail part
- local $mail = &parse_imap_mail($rv[1]->[$i]);
- if ($mail) {
- $mail->{'idx'} = $start+$i;
- $mail[$start+$i] = $mail;
- }
- }
- return @mail;
- }
- elsif ($_[2]->{'type'} == 5) {
- # A composite folder, which combined two or more others.
- local @mail;
- # Work out exactly how big the total is
- local ($sf, %len, $count);
- foreach $sf (@{$_[2]->{'subfolders'}}) {
- print DEBUG "working out size of ",&folder_name($sf),"\n";
- $len{$sf} = &mailbox_folder_size($sf);
- $count += $len{$sf};
- }
- # Work out what range we need
- local ($start, $end) = &compute_start_end($_[0], $_[1], $count);
- # Fetch the needed part of each sub-folder
- local $pos = 0;
- foreach $sf (@{$_[2]->{'subfolders'}}) {
- local ($sfstart, $sfend);
- local $sfn = &folder_name($sf);
- $sfstart = $start - $pos;
- $sfend = $end - $pos;
- $sfstart = $sfstart < 0 ? 0 :
- $sfstart >= $len{$sf} ? $len{$sf}-1 : $sfstart;
- $sfend = $sfend < 0 ? 0 :
- $sfend >= $len{$sf} ? $len{$sf}-1 : $sfend;
- print DEBUG "getting mail from $sfstart to $sfend in $sfn\n";
- local @submail =
- &mailbox_list_mails($sfstart, $sfend, $sf, $_[3]);
- local $sm;
- foreach $sm (@submail) {
- if ($sm) {
- # ID is the original folder and ID
- $sm->{'id'} = $sfn."\t".$sm->{'id'};
- }
- }
- push(@mail, @submail);
- $pos += $len{$sf};
- }
- return @mail;
- }
- elsif ($_[2]->{'type'} == 6) {
- # A virtual folder, which just contains ids of mails in other folders
- local $mems = $folder->{'members'};
- local ($start, $end) = &compute_start_end($_[0], $_[1], scalar(@$mems));
- # Build a map from sub-folder names to IDs in them
- local (%wantmap, %namemap);
- for(my $i=$start; $i<=$end; $i++) {
- local $sf = $mems->[$i]->[0];
- local $sid = $mems->[$i]->[1];
- local $sfn = &folder_name($sf);
- $namemap{$sfn} = $sf;
- push(@{$wantmap{$sfn}}, [ $sid, $i ]);
- }
- # For each sub-folder, get the IDs we need, and put them into the
- # return array at the right place
- local @mail = map { undef } (0 .. @$mems-1);
- local $changed = 0;
- foreach my $sfn (keys %wantmap) {
- local $sf = $namemap{$sfn};
- local @wantids = map { $_->[0] } @{$wantmap{$sfn}};
- local @wantidxs = map { $_->[1] } @{$wantmap{$sfn}};
- local @sfmail = &mailbox_select_mails($sf, \@wantids, $_[3]);
- for(my $i=0; $i<@sfmail; $i++) {
- $mail[$wantidxs[$i]] = $sfmail[$i];
- if ($sfmail[$i]) {
- # Original mail exists .. add to results
- if ($sfmail[$i]->{'id'} ne $wantids[$i]) {
- # Under new ID now - fix up index
- print DEBUG "wanted ID ",$wantids[$i],
- " got ",$sfmail[$i]->{'id'},"\n";
- local ($m) = grep {
- $_->[1] eq $wantids[$i] } @$mems;
- if ($m) {
- $m->[1] = $sfmail[$i]->{'id'};
- $changed = 1;
- }
- }
- $sfmail[$i]->{'idx'} = $wantidxs[$i];
- $sfmail[$i]->{'id'} =
- $sfn."\t".$sfmail[$i]->{'id'};
- }
- else {
- # Take out of virtual folder index
- print DEBUG "underlying email $sfn $wantids[$i] is gone!\n";
- $mems = [ grep { $_->[0] ne $sf ||
- $_->[1] ne $wantids[$i] } @$mems ];
- $changed = 1;
- $mail[$wantidxs[$i]] = 'GONE';
- }
- }
- }
- if ($changed) {
- # Need to save virtual folder
- $folder->{'members'} = $mems;
- &save_folder($folder, $folder);
- }
- # Filter out messages that don't exist anymore
- @mail = grep { $_ ne 'GONE' } @mail;
- return @mail;
- }
- }
- # mailbox_select_mails(&folder, &ids, headersonly)
- # Returns only messages from a folder with unique IDs in the given array
- sub mailbox_select_mails
- {
- local ($folder, $ids, $headersonly) = @_;
- if ($folder->{'type'} == 0) {
- # mbox folder
- return &select_mails($folder->{'file'}, $ids, $headersonly);
- }
- elsif ($folder->{'type'} == 1) {
- # Maildir folder
- return &select_maildir($folder->{'file'}, $ids, $headersonly);
- }
- elsif ($folder->{'type'} == 3) {
- # MH folder
- return &select_mhdir($folder->{'file'}, $ids, $headersonly);
- }
- elsif ($folder->{'type'} == 2) {
- # POP folder
- # Login first
- local @rv = &pop3_login($folder);
- if ($rv[0] != 1) {
- # Failed to connect or login
- if ($_[4]) {
- @{$_[4]} = @rv;
- return ();
- }
- elsif ($rv[0] == 0) { &error($rv[1]); }
- else { &error(&text('save_elogin', $rv[1])); }
- }
- local $h = $rv[1];
- local @uidl = &pop3_uidl($h);
- local %uidlmap; # Map from UIDLs to POP3 indexes
- for(my $i=0; $i<@uidl; $i++) {
- $uidlmap{$uidl[$i]} = $i+1;
- }
- # Work out what we have cached
- local ($i, $f, %cached, %sizeneed);
- local @rv;
- local $cd = "$cache_directory/$_[2]->{'id'}.cache";
- if (opendir(CACHE, $cd)) {
- while($f = readdir(CACHE)) {
- if ($f =~ /^(\S+)\.body$/) {
- $cached{$1} = 2;
- }
- elsif ($f =~ /^(\S+)\.headers$/) {
- $cached{$1} = 1;
- }
- }
- closedir(CACHE);
- }
- else {
- mkdir($cd, 0700);
- }
- # For each requested uidl, get the headers or body
- foreach my $i (@$ids) {
- local $u = &safe_uidl($i);
- print DEBUG "need uidl $i -> $uidlmap{$i}\n";
- if ($cached{$u} == 2 || $cached{$u} == 1 && $headersonly) {
- # We already have everything that we need
- }
- elsif ($cached{$u} == 1 || !$headersonly) {
- # We need to get the entire mail
- &pop3_command($h, "retr ".$uidlmap{$i});
- open(CACHE, ">$cd/$u.body");
- while(<$h>) {
- s/\r//g;
- last if ($_ eq ".\n");
- print CACHE $_;
- }
- close(CACHE);
- unlink("$cd/$u.headers");
- $cached{$u} = 2;
- }
- else {
- # We just need the headers
- &pop3_command($h, "top ".$uidlmap{$i}." 0");
- open(CACHE, ">$cd/$u.headers");
- while(<$h>) {
- s/\r//g;
- last if ($_ eq ".\n");
- print CACHE $_;
- }
- close(CACHE);
- $cached{$u} = 1;
- }
- local $mail = &read_mail_file($cached{$u} == 2 ?
- "$cd/$u.body" : "$cd/$u.headers");
- if ($cached{$u} == 1) {
- if ($mail->{'body'} ne "") {
- $mail->{'size'} = length($mail->{'body'});
- }
- else {
- $sizeneed{$uidlmap{$i}} = $mail;
- }
- }
- $mail->{'idx'} = $uidlmap{$i}-1;
- $mail->{'id'} = $i;
- push(@rv, $mail);
- }
- # Get sizes for mails if needed
- if (%sizeneed) {
- &pop3_command($h, "list");
- while(<$h>) {
- s/\r//g;
- last if ($_ eq ".\n");
- if (/^(\d+)\s+(\d+)/ && $sizeneed{$1}) {
- # Find mail in results, and set its size
- local ($ns) = $sizeneed{$1};
- $ns->{'size'} = $2;
- local $u = &safe_uidl($uidl[$1-1]);
- open(CACHE, ">>$cd/$u.headers");
- print CACHE $2,"\n";
- close(CACHE);
- }
- }
- }
- return @rv;
- }
- elsif ($folder->{'type'} == 4) {
- # IMAP folder
- # Login and select the specified mailbox
- local @irv = &imap_login($folder);
- if ($irv[0] != 1) {
- # Something went wrong
- if ($_[4]) {
- @{$_[4]} = @irv;
- return ();
- }
- elsif ($irv[0] == 0) { &error($irv[1]); }
- elsif ($irv[0] == 3) { &error(&text('save_emailbox', $irv[1]));}
- elsif ($irv[0] == 2) { &error(&text('save_elogin2', $irv[1])); }
- }
- local $h = $irv[1];
- local $count = $irv[2];
- return () if (!$count);
- $folder->{'lastchange'} = $irv[3] if ($irv[3]);
- # Build map from IDs to original order, as UID FETCH doesn't return
- # mail in the order we asked for!
- local %wantpos;
- for(my $i=0; $i<@$ids; $i++) {
- $wantpos{$ids->[$i]} = $i;
- }
- # Fetch each mail by ID. This is done in blocks of 1000, to avoid
- # hitting a the IMAP server's max request limit
- local @rv = map { undef } @$ids;
- local $wanted = $headersonly ? "(RFC822.SIZE UID FLAGS RFC822.HEADER)"
- : "(UID FLAGS BODY.PEEK[])";
- if (@$ids) {
- for(my $chunk=0; $chunk<@$ids; $chunk+=1000) {
- local $chunkend = $chunk+999;
- if ($chunkend >= @$ids) { $chunkend = @$ids-1; }
- local @cids = @$ids[$chunk .. $chunkend];
- local @idxrv = &imap_command($h,
- "UID FETCH ".join(",", @cids)." $wanted");
- foreach my $idxrv (@{idxrv->[1]}) {
- local $mail = &parse_imap_mail($idxrv);
- if ($mail) {
- $mail->{'idx'} = $mail->{'imapidx'}-1;
- $rv[$wantpos{$mail->{'id'}}] = $mail;
- }
- }
- }
- }
- print DEBUG "imap rv = ",scalar(@rv),"\n";
- return @rv;
- }
- elsif ($folder->{'type'} == 5 || $folder->{'type'} == 6) {
- # Virtual or composite folder .. for each ID, work out the folder and
- # build a map from folders to ID lists
- print DEBUG "selecting ",scalar(@$ids)," ids\n";
- # Build a map from sub-folder names to IDs in them
- my $i = 0;
- my %wantmap;
- foreach my $id (@$ids) {
- local ($sfn, $sid) = split(/\t+/, $id, 2);
- push(@{$wantmap{$sfn}}, [ $sid, $i ]);
- $i++;
- }
- # Build map from sub-folder names to IDs
- my (%namemap, @allids, $mems);
- if ($folder->{'type'} == 6) {
- # For a virtual folder, we need to find all sub-folders
- $mems = $folder->{'members'};
- foreach my $m (@$mems) {
- local $sfn = &folder_name($m->[0]);
- $namemap{$sfn} = $m->[0];
- push(@allids, $sfn."\t".$m->[1]);
- }
- }
- else {
- # For a composite, they are simply listed
- foreach my $sf (@{$folder->{'subfolders'}}) {
- local $sfn = &folder_name($sf);
- $namemap{$sfn} = $sf;
- }
- @allids = &mailbox_idlist($folder);
- }
- # For each sub-folder, get the IDs we need, and put them into the
- # return array at the right place
- local @mail = map { undef } @$ids;
- foreach my $sfn (keys %wantmap) {
- local $sf = $namemap{$sfn};
- local @wantids = map { $_->[0] } @{$wantmap{$sfn}};
- local @wantidxs = map { $_->[1] } @{$wantmap{$sfn}};
- local @sfmail = &mailbox_select_mails($sf, \@wantids,
- $headersonly);
- for(my $i=0; $i<@sfmail; $i++) {
- $mail[$wantidxs[$i]] = $sfmail[$i];
- if ($sfmail[$i]) {
- # Original mail exists .. add to results
- $sfmail[$i]->{'id'} =
- $sfn."\t".$sfmail[$i]->{'id'};
- $sfmail[$i]->{'idx'} = &indexof(
- $sfmail[$i]->{'id'}, @allids);
- print DEBUG "looking for ",$sfmail[$i]->{'id'}," found at ",$sfmail[$i]->{'idx'},"\n";
- }
- else {
- # Take out of virtual folder index
- print DEBUG "underlying email $sfn $wantids[$i] is gone!\n";
- $mems = [ grep { $_->[0] ne $sf ||
- $_->[1] ne $wantids[$i] } @$mems ];
- $changed = 1;
- }
- }
- }
- if ($changed && $folder->{'type'} == 6) {
- # Need to save virtual folder
- $folder->{'members'} = $mems;
- &save_folder($folder, $folder);
- }
- return @mail;
- }
- }
- # mailbox_get_mail(&folder, id, headersonly)
- # Convenience function to get a single mail by ID
- sub mailbox_get_mail
- {
- local ($folder, $id, $headersonly) = @_;
- local ($mail) = &mailbox_select_mails($folder, [ $id ], $headersonly);
- if ($mail) {
- # 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";
- }
- else {
- # Need to extract from sort index
- local @sorter = &build_sorted_ids($folder, $field, $dir);
- $mail->{'sortidx'} = &indexof($id, @sorter);
- }
- }
- return $mail;
- }
- # mailbox_idlist(&folder)
- # Returns a list of IDs of messages in some folder
- sub mailbox_idlist
- {
- local ($folder) = @_;
- if ($folder->{'type'} == 0) {
- # mbox, for which IDs are mail positions
- print DEBUG "starting to get IDs from $folder->{'file'}\n";
- local @idlist = &idlist_mails($folder->{'file'});
- print DEBUG "got ",scalar(@idlist)," ids\n";
- return @idlist;
- }
- elsif ($folder->{'type'} == 1) {
- # maildir, for which IDs are filenames
- return &idlist_maildir($folder->{'file'});
- }
- elsif ($folder->{'type'} == 2) {
- # pop3, for which IDs are uidls
- local @rv = &pop3_login($folder);
- if ($rv[0] != 1) {
- # Failed to connect or login
- if ($rv[0] == 0) { &error($rv[1]); }
- else { &error(&text('save_elogin', $rv[1])); }
- }
- local $h = $rv[1];
- local @uidl = &pop3_uidl($h);
- return @uidl;
- }
- elsif ($folder->{'type'} == 3) {
- # MH directory, for which IDs are file numbers
- return &idlist_mhdir($folder->{'file'});
- }
- elsif ($folder->{'type'} == 4) {
- # IMAP, for which IDs are IMAP UIDs
- local @rv = &imap_login($folder);
- if ($rv[0] != 1) {
- # Something went wrong
- if ($rv[0] == 0) { &error($rv[1]); }
- elsif ($rv[0] == 3) { &error(&text('save_emailbox', $rv[1])); }
- elsif ($rv[0] == 2) { &error(&text('save_elogin2', $rv[1])); }
- }
- local $h = $rv[1];
- local $count = $rv[2];
- return () if (!$count);
- $folder->{'lastchange'} = $irv[3] if ($irv[3]);
- @rv = &imap_command($h, "FETCH 1:$count UID");
- local @uids;
- foreach my $uid (@{$rv[1]}) {
- if ($uid =~ /UID\s+(\d+)/) {
- push(@uids, $1);
- }
- }
- return @uids;
- }
- elsif ($folder->{'type'} == 5) {
- # Composite, IDs come from sub-folders
- local @rv;
- foreach my $sf (@{$folder->{'subfolders'}}) {
- local $sfn = &folder_name($sf);
- push(@rv, map { $sfn."\t".$_ } &mailbox_idlist($sf));
- }
- return @rv;
- }
- elsif ($folder->{'type'} == 6) {
- # Virtual, IDs come from sub-folders (where they exist)
- my (%wantmap, %namemap);
- foreach my $m (@{$folder->{'members'}}) {
- local $sf = $m->[0];
- local $sid = $m->[1];
- local $sfn = &folder_name($sf);
- push(@{$wantmap{$sfn}}, $sid);
- $namemap{$sfn} = $sf;
- }
- local @rv;
- foreach my $sfn (keys %wantmap) {
- local %wantids = map { $_, 1 } @{$wantmap{$sfn}};
- local $sf = $namemap{$sfn};
- foreach my $sfid (&mailbox_idlist($sf)) {
- if ($wantids{$sfid}) {
- push(@rv, $sfn."\t".$sfid);
- }
- }
- }
- return @rv;
- }
- }
- # compute_start_end(start, end, count)
- # Given start and end indexes (which may be negative or undef), returns the
- # real mail file indexes.
- sub compute_start_end
- {
- local ($start, $end, $count) = @_;
- if (!defined($start)) {
- return (0, $count-1);
- }
- elsif ($end < 0) {
- local $rstart = $count+$_[1]-1;
- local $rend = $count+$_[0]-1;
- $rstart = $rstart < 0 ? 0 : $rstart;
- $rend = $count - 1 if ($rend >= $count);
- return ($rstart, $rend);
- }
- else {
- local $rend = $_[1];
- $rend = $count - 1 if ($rend >= $count);
- return ($start, $rend);
- }
- }
- # mailbox_list_mails_sorted(start, end, &folder, [headeronly], [&error],
- # [sort-field, sort-dir])
- # Returns messages in a folder within the given range, but sorted by the
- # given field and condition.
- sub mailbox_list_mails_sorted
- {
- local ($start, $end, $folder, $headersonly, $error, $field, $dir) = @_;
- if (!$field) {
- # Default to current ordering
- ($field, $dir) = &get_sort_field($folder);
- }
- if (!$field || !$folder->{'sortable'}) {
- # No sorting .. just return newest first
- local @rv = reverse(&mailbox_list_mails(
- -$start, -$end-1, $folder, $headersonly, $error));
- local $i = 0;
- foreach my $m (@rv) {
- $m->{'sortidx'} = $i++;
- }
- return @rv;
- }
- # For IMAP, login first so that the lastchange can be found
- if ($folder->{'type'} == 4 && !$folder->{'lastchange'}) {
- &mailbox_select_mails($folder, [ ], 1);
- }
- # Get a sorted list of IDs, and then find the real emails within the range
- local @sorter = &build_sorted_ids($folder, $field, $dir);
- ($start, $end) = &compute_start_end($start, $end, scalar(@sorter));
- print DEBUG "for ",&folder_name($folder)," sorter = ",scalar(@sorter),"\n";
- print DEBUG "start = $start end = $end\n";
- local @rv = map { undef } (0 .. scalar(@sorter)-1);
- local @wantids = map { $sorter[$_] } ($start .. $end);
- print DEBUG "wantids = ",scalar(@wantids),"\n";
- local @mails = &mailbox_select_mails($folder, \@wantids, $headersonly);
- for(my $i=0; $i<@mails; $i++) {
- $rv[$start+$i] = $mails[$i];
- print DEBUG "setting $start+$i to ",$mails[$i]," id ",$wantids[$i],"\n";
- $mails[$i]->{'sortidx'} = $start+$i;
- }
- print DEBUG "rv = ",scalar(@rv),"\n";
- return @rv;
- }
- # build_sorted_ids(&folder, field, dir)
- # Returns a list of message IDs in some folder, sorted on some field
- sub build_sorted_ids
- {
- local ($folder, $field, $dir) = @_;
- # Delete old sort indexes
- &delete_old_sort_index($folder);
- # 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);
- # Get message indexes, sorted by the field
- my @sorter;
- while(my ($k, $v) = each %index) {
- if ($k =~ /^(.*)_\Q$field\E$/) {
- push(@sorter, [ $1, lc($v) ]);
- }
- }
- 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;
- }
- else {
- # Alpha sort
- @sorter = sort { my $s = $a->[1] cmp $b->[1]; $dir ? $s : -$s } @sorter;
- }
- return map { $_->[0] } @sorter;
- }
- # delete_old_sort_index(&folder)
- # Delete old index DBM files
- sub delete_old_sort_index
- {
- local ($folder) = @_;
- local $ifile = &folder_sort_index_file($folder);
- $ifile =~ /^(.*)\/([^\/]+)$/;
- local ($idir, $iname) = ($1, $2);
- opendir(IDIR, $idir);
- foreach my $f (readdir(IDIR)) {
- if ($f eq $iname || $f =~ /^\Q$iname\E\.[^\.]+$/) {
- unlink("$idir/$f");
- }
- }
- closedir(IDIR);
- }
- # build_new_sort_index(&folder, field, &index)
- # Builds and/or loads the index for sorting a folder on some field. The
- # index uses the mail number as the key, and the field value as the value.
- sub build_new_sort_index
- {
- local ($folder, $field, $index) = @_;
- return 0 if (!$folder->{'sortable'});
- 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'} ||
- !$folder->{'lastchange'}) {
- # The mail file has changed .. get IDs and update the index with any
- # that are missing
- local @ids = &mailbox_idlist($folder);
- # Find IDs that are new
- local @newids;
- foreach my $id (@ids) {
- if (!defined($index->{$id."_size"})) {
- push(@newids, $id);
- }
- }
- local @mails = scalar(@newids) ?
- &mailbox_select_mails($folder, \@newids, 1) : ( );
- foreach my $mail (@mails) {
- foreach my $f (@index_fields) {
- if ($f eq "date") {
- # Convert date to Unix time
- $index->{$mail->{'id'}."_date"} =
- &parse_mail_date($mail->{'header'}->{'date'});
- }
- elsif ($f eq "size") {
- # Get mail size
- $index->{$mail->{'id'}."_size"} =
- $mail->{'size'};
- }
- elsif ($f eq "from" || $f eq "to") {
- # From: header .. convert to display version
- $index->{$mail->{'id'}."_".$f} =
- &simplify_from($mail->{'header'}->{$f});
- }
- elsif ($f eq "subject") {
- # Convert subject to display version
- $index->{$mail->{'id'}."_".$f} =
- &simplify_subject($mail->{'header'}->{$f});
- }
- elsif ($f eq "x-spam-status") {
- # Extract spam score
- $index->{$mail->{'id'}."_".$f} =
- $mail->{'header'}->{$f} =~ /(hits|score)=([0-9\.]+)/ ? $2 : undef;
- }
- else {
- # Just a header
- $index->{$mail->{'id'}."_".$f} =
- $mail->{'header'}->{$f};
- }
- }
- }
- print DEBUG "added ",scalar(@mails)," messages to index\n";
- # Remove IDs that no longer exist
- 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");
- }
- }
- foreach my $k (@todelete) {
- delete($index->{$k});
- }
- print DEBUG "deleted $dc messages from index\n";
- # Record index update time
- $index->{'lastchange'} = $folder->{'lastchange'} || time();
- $index->{'mailcount'} = scalar(@ids);
- print DEBUG "new indexchange=$index->{'lastchange'}\n";
- }
- return 1;
- }
- # delete_new_sort_index_message(&folder, id)
- # Removes a message ID from a sort index
- sub delete_new_sort_index_message
- {
- local ($folder, $id) = @_;
- local %index;
- &build_new_sort_index($folder, undef, \%index);
- foreach my $field (@index_fields) {
- delete($index{$id."_".$field});
- }
- dbmclose(%index);
- if ($folder->{'type'} == 5 || $folder->{'type'} == 6) {
- # Remove from underlying folder's index too
- local ($sfn, $sid) = split(/\t+/, $id, 2);
- local $sf = &find_subfolder($folder, $sfn);
- if ($sf) {
- &delete_new_sort_index_message($sf, $sid);
- }
- }
- }
- # force_new_index_recheck(&folder)
- # Resets the last-updated time on a folder's index, to force a re-check
- sub force_new_index_recheck
- {
- local ($folder) = @_;
- local %index;
- &build_new_sort_index($folder, undef, \%index);
- $index{'lastchange'} = 0;
- dbmclose(%index);
- }
- # delete_new_sort_index(&folder)
- # Trashes the sort index for a folder, to force a rebuild
- sub delete_new_sort_index
- {
- local ($folder) = @_;
- local $ifile = &folder_new_sort_index_file($folder);
- my %index;
- &open_dbm_db(\%index, $ifile, 0600);
- %index = ( );
- }
- # folder_sort_index_file(&folder)
- # Returns the index file to use for some folder
- sub folder_sort_index_file
- {
- local ($folder) = @_;
- return &user_index_file(($folder->{'file'} || $folder->{'id'}).".sort");
- }
- # folder_new_sort_index_file(&folder)
- # Returns the new ID-style index file to use for some folder
- sub folder_new_sort_index_file
- {
- local ($folder) = @_;
- return &user_index_file(($folder->{'file'} || $folder->{'id'}).".byid");
- }
- # mailbox_search_mail(&fields, andmode, &folder, [&limit], [headersonly])
- # Search a mailbox for multiple matching fields
- sub mailbox_search_mail
- {
- local ($fields, $andmode, $folder, $limit, $headersonly) = @_;
- # For folders other than IMAP and composite and mbox where we already have
- # an index, build a sort index and use that for
- # the search, if it is simple enough (Subject, From and To only)
- local @idxfields = grep { $_->[0] eq 'from' || $_->[0] eq 'to' ||
- $_->[0] eq 'subject' } @{$_[0]};
- if ($folder->{'type'} != 4 &&
- $folder->{'type'} != 5 &&
- $folder->{'type'} != 6 &&
- ($folder->{'type'} != 0 || !&has_dbm_index($folder->{'file'})) &&
- scalar(@idxfields) == scalar(@$fields) && @idxfields &&
- &get_product_name() eq 'usermin') {
- print DEBUG "using index to search\n";
- local %index;
- &build_new_sort_index($folder, undef, \%index);
- local @rv;
- # Work out which mail IDs match the requested headers
- local %idxmatches = map { ("$_->[0]/$_->[1]", [ ]) } @idxfields;
- while(my ($k, $v) = each %index) {
- $k =~ /^(.+)_(\S+)$/ || next;
- local ($ki, $kf) = ($1, $2);
- next if (!$kf || $ki eq '');
- # Check all of the fields to see which ones match
- foreach my $if (@idxfields) {
- local $iff = $if->[0];
- local ($neg) = ($iff =~ s/^\!//);
- next if ($kf ne $iff);
- local $re = $if->[2] ? $if->[1] : "\Q$if->[1]\E";
- if (!$neg && $v =~ /$re/i ||
- $neg && $v !~ /$re/i) {
- push(@{$idxmatches{"$if->[0]/$if->[1]"}}, $ki);
- }
- }
- }
- local @matches;
- if ($_[1]) {
- # Find indexes in all arrays
- local %icount;
- foreach my $if (keys %idxmatches) {
- foreach my $i (@{$idxmatches{$if}}) {
- $icount{$i}++;
- }
- }
- foreach my $i (keys %icount) {
- }
- local $fif = $idxfields[0];
- @matches = grep { $icount{$_} == scalar(@idxfields) }
- @{$idxmatches{"$fif->[0]/$fif->[1]"}};
- }
- else {
- # Find indexes in any array
- foreach my $if (keys %idxmatches) {
- push(@matches, @{$idxmatches{$if}});
- }
- @matches = &unique(@matches);
- }
- @matches = sort { $a cmp $b } @matches;
- print DEBUG "matches = ",join(" ", @matches),"\n";
- # Select the actual mails
- return &mailbox_select_mails($_[2], \@matches, $headersonly);
- }
- if ($folder->{'type'} == 0) {
- # Just search an mbox format file (which will use its own special
- # field-level index)
- return &advanced_search_mail($folder->{'file'}, $fields,
- $andmode, $limit, $headersonly);
- }
- elsif ($folder->{'type'} == 1) {
- # Search a maildir directory
- return &advanced_search_maildir($folder->{'file'}, $fields,
- $andmode, $limit, $headersonly);
- }
- elsif ($folder->{'type'} == 2) {
- # Get all of the mail from the POP3 server and search it
- local ($min, $max);
- if ($limit && $limit->{'latest'}) {
- $min = -1;
- $max = -$limit->{'latest'};
- }
- local @mails = &mailbox_list_mails($min, $max, $folder,
- &indexof('body', &search_fields($fields)) < 0 &&
- $headersonly);
- local @rv = grep { $_ && &mail_matches($fields, $andmode, $_) } @mails;
- }
- elsif ($folder->{'type'} == 3) {
- # Search an MH directory
- return &advanced_search_mhdir($folder->{'file'}, $fields,
- $andmode, $limit, $headersonly);
- }
- elsif ($folder->{'type'} == 4) {
- # Use IMAP's remote search feature
- local @rv = &imap_login($_[2]);
- if ($rv[0] == 0) { &error($rv[1]); }
- elsif ($rv[0] == 3) { &error(&text('save_emailbox', $rv[1])); }
- elsif ($rv[0] == 2) { &error(&text('save_elogin2', $rv[1])); }
- local $h = $rv[1];
- $_[2]->{'lastchange'} = $rv[3] if ($rv[3]);
- # Do the search to get back a list of matching numbers
- local @search;
- foreach $f (@{$_[0]}) {
- local $field = $f->[0] eq "date" ? "on" : $f->[0];
- local $neg = ($field =~ s/^\!//);
- local $what = $f->[1];
- if ($field ne "size") {
- $what = "\"".$what."\""
- }
- $field = "LARGER" if ($field eq "size");
- local $search = uc($field)." ".$what."";
- $search = "NOT $search" if ($neg);
- push(@searches, $search);
- }
- local $searches;
- if (@searches == 1) {
- $searches = $searches[0];
- }
- elsif ($_[1]) {
- $searches = join(" ", @searches);
- }
- else {
- $searches = $searches[$#searches];
- for($i=$#searches-1; $i>=0; $i--) {
- $searches = "or $searches[$i] ($searches)";
- }
- }
- @rv = &imap_command($h, "UID SEARCH $searches");
- &error(&text('save_esearch', $rv[3])) if (!$rv[0]);
- # Get back the IDs we want
- local ($srch) = grep { $_ =~ /^\*\s+SEARCH/i } @{$rv[1]};
- local @ids = split(/\s+/, $srch);
- shift(@ids); shift(@ids); # lose * SEARCH
- # Call the select function to get the mails
- return &mailbox_select_mails($folder, \@ids, $headersonly);
- }
- elsif ($folder->{'type'} == 5) {
- # Search each sub-folder and combine the results - taking any count
- # limits into effect
- local $sf;
- local $pos = 0;
- local @mail;
- local (%start, %len);
- foreach $sf (@{$folder->{'subfolders'}}) {
- $len{$sf} = &mailbox_folder_size($sf);
- $start{$sf} = $pos;
- $pos += $len{$sf};
- }
- local $limit = $limit ? { %$limit } : undef;
- $limit = undef;
- foreach $sf (reverse(@{$folder->{'subfolders'}})) {
- local $sfn = &folder_name($sf);
- print DEBUG "searching on sub-folder ",&folder_name($sf),"\n";
- local @submail = &mailbox_search_mail($fields, $andmode, $sf,
- $limit, $headersonly);
- print DEBUG "found ",scalar(@submail),"\n";
- foreach my $sm (@submail) {
- $sm->{'id'} = $sfn."\t".$sm->{'id'};
- }
- push(@mail, reverse(@submail));
- if ($limit && $limit->{'latest'}) {
- # Adjust latest down by size of this folder
- $limit->{'latest'} -= $len{$sf};
- last if ($limit->{'latest'} <= 0);
- }
- }
- return reverse(@mail);
- }
- elsif ($folder->{'type'} == 6) {
- # Just run a search on the sub-mails
- local @rv;
- local ($min, $max);
- if ($limit && $limit->{'latest'}) {
- $min = -1;
- $max = -$limit->{'latest'};
- }
- local $mail;
- local $sfn = &folder_name($sf);
- print DEBUG "searching virtual folder ",&folder_name($folder),"\n";
- foreach $mail (&mailbox_list_mails($min, $max, $folder)) {
- if ($mail && &mail_matches($fields, $andmode, $mail)) {
- push(@rv, $mail);
- }
- }
- return @rv;
- }
- }
- # mailbox_delete_mail(&folder, mail, ...)
- # Delete multiple messages from some folder
- sub mailbox_delete_mail
- {
- return undef if (&is_readonly_mode());
- local $f = shift(@_);
- if ($userconfig{'delete_mode'} == 1 && !$f->{'trash'} && !$f->{'spam'} &&
- !$f->{'notrash'}) {
- # Copy to trash folder first .. if we have one
- local ($trash) = grep { $_->{'trash'} } &list_folders();
- if ($trash) {
- my $r;
- my $save_read = &get_product_name() eq "usermin";
- foreach my $m (@_) {
- $r = &get_mail_read($f, $m) if ($save_read);
- my $mcopy = { %$m }; # Because writing changes id
- &write_mail_folder($mcopy, $trash);
- &set_mail_read($trash, $mcopy, $r) if ($save_read);
- }
- }
- }
- if ($f->{'type'} == 0) {
- # Delete from mbox
- &delete_mail($f->{'file'}, @_);
- }
- elsif ($f->{'type'} == 1) {
- # Delete from Maildir
- &delete_maildir(@_);
- }
- elsif ($f->{'type'} == 2) {
- # Login and delete from the POP3 server
- local @rv = &pop3_login($f);
- if ($rv[0] == 0) { &error($rv[1]); }
- elsif ($rv[0] == 2) { &error(&text('save_elogin', $rv[1])); }
- local $h = $rv[1];
- local @uidl = &pop3_uidl($h);
- local $m;
- local $cd = "$cache_directory/$f->{'id'}.cache";
- foreach $m (@_) {
- local $idx = &indexof($m->{'id'}, @uidl);
- if ($idx >= 0) {
- &pop3_command($h, "dele ".($idx+1));
- local $u = &safe_uidl($m->{'id'});
- unlink("$cd/$u.headers", "$cd/$u.body");
- }
- }
- }
- elsif ($f->{'type'} == 3) {
- # Delete from MH dir
- &delete_mhdir(@_);
- }
- elsif ($f->{'type'} == 4) {
- # Delete from the IMAP server
- local @rv = &imap_login($f);
- if ($rv[0] == 0) { &error($rv[1]); }
- elsif ($rv[0] == 3) { &error(&text('save_emailbox', $rv[1])); }
- elsif ($rv[0] == 2) { &error(&text('save_elogin2', $rv[1])); }
- local $h = $rv[1];
- local $m;
- foreach $m (@_) {
- @rv = &imap_command($h, "UID STORE ".$m->{'id'}.
- " +FLAGS (\\Deleted)");
- &error(&text('save_edelete', $rv[3])) if (!$rv[0]);
- }
- @rv = &imap_command($h, "EXPUNGE");
- &error(&text('save_edelete', $rv[3])) if (!$rv[0]);
- }
- elsif ($f->{'type'} == 5 || $f->{'type'} == 6) {
- # Delete from underlying folder(s), and from virtual index
- foreach my $sm (@_) {
- local ($sfn, $sid) = split(/\t+/, $sm->{'id'}, 2);
- local $sf = &find_subfolder($f, $sfn);
- $sf || &error("Failed to find sub-folder named $sfn");
- if ($f->{'type'} == 5 || $f->{'type'} == 6 && $f->{'delete'}) {
- $sm->{'id'} = $sid;
- &mailbox_delete_mail($sf, $sm);
- $sm->{'id'} = $sfn."\t".$sm->{'id'};
- }
- if ($f->{'type'} == 6) {
- $f->{'members'} = [
- grep { $_->[0] ne $sf ||
- $_->[1] ne $sid } @{$f->{'members'}} ];
- }
- }
- if ($f->{'type'} == 6) {
- # Save new ID list
- &save_folder($f, $f);
- }
- }
- # Always force a re-check of the index when deleting, as we may not detect
- # the change (especially for IMAP, where UIDNEXT may not change). This isn't
- # needed for Maildir or MH, as indexing is reliable enough
- if ($f->{'type'} != 1 && $f->{'type'} != 3) {
- &force_new_index_recheck($f);
- }
- }
- # mailbox_empty_folder(&folder)
- # Remove the entire contents of a mail folder
- sub mailbox_empty_folder
- {
- return undef if (&is_readonly_mode());
- local $f = $_[0];
- if ($f->{'type'} == 0) {
- # mbox format mail file
- &empty_mail($f->{'file'});
- }
- elsif ($f->{'type'} == 1) {
- # qmail format maildir
- &empty_maildir($f->{'file'});
- }
- elsif ($f->{'type'} == 2) {
- # POP3 server .. delete all messages
- local @rv = &pop3_login($f);
- if ($rv[0] == 0) { &error($rv[1]); }
- elsif ($rv[0] == 2) { &error(&text('save_elogin', $rv[1])); }
- local $h = $rv[1];
- @rv = &pop3_command($h, "stat");
- $rv[1] =~ /^(\d+)/ || return;
- local $count = $1;
- local $i;
- for($i=1; $i<=$count; $i++) {
- &pop3_command($h, "dele ".$i);
- }
- }
- elsif ($f->{'type'} == 3) {
- # mh format maildir
- &empty_mhdir($f->{'file'});
- }
- elsif ($f->{'type'} == 4) {
- # IMAP server .. delete all messages
- local @rv = &imap_login($f);
- if ($rv[0] == 0) { &error($rv[1]); }
- elsif ($rv[0] == 3) { &error(&text('save_emailbox', $rv[1])); }
- elsif ($rv[0] == 2) { &error(&text('save_elogin2', $rv[1])); }
- local $h = $rv[1];
- local $count = $rv[2];
- local $i;
- for($i=1; $i<=$count; $i++) {
- @rv = &imap_command($h, "STORE ".$i.
- " +FLAGS (\\Deleted)");
- &error(&text('save_edelete', $rv[3])) if (!$rv[0]);
- }
- @rv = &imap_command($h, "EXPUNGE");
- &error(&text('save_edelete', $rv[3])) if (!$rv[0]);
- }
- elsif ($f->{'type'} == 5) {
- # Empty each sub-folder
- local $sf;
- foreach $sf (@{$f->{'subfolders'}}) {
- &mailbox_empty_folder($sf);
- }
- }
- elsif ($f->{'type'} == 6) {
- if ($folder->{'delete'}) {
- # Delete all underlying messages
- local @dmails = &mailbox_list_mails(undef, undef, $f, 1);
- &mailbox_delete_mail($f, @dmails);
- }
- else {
- # Clear the virtual index
- $f->{'members'} = [ ];
- &save_folder($f);
- }
- }
- # Trash the folder index
- if ($folder->{'sortable'}) {
- &delete_new_sort_index($folder);
- }
- }
- # mailbox_copy_folder(&source, &dest)
- # Copy all messages from one folder to another. This is done in an optimized
- # way if possible.
- sub mailbox_copy_folder
- {
- local ($src, $dest) = @_;
- if ($src->{'type'} == 0 && $dest->{'type'} == 0) {
- # mbox to mbox .. just read and write the files
- &open_readfile(SOURCE, $src->{'file'});
- &open_tempfile(DEST, ">>$dest->{'file'}");
- while(read(SOURCE, $buf, 1024) > 0) {
- &print_tempfile(DEST, $buf);
- }
- &close_tempfile(DEST);
- close(SOURCE);
- }
- elsif ($src->{'type'} == 1 && $dest->{'type'} == 1) {
- # maildir to maildir .. just copy the files
- local @files = &get_maildir_files($src->{'file'});
- foreach my $f (@files) {
- local $fn = &unique_maildir_filename($dest);
- ©_source_dest($f, "$dest->{'file'}/$fn");
- }
- &mailbox_fix_permissions($dest);
- }
- elsif ($src->{'type'} == 1 && $dest->{'type'} == 0) {
- # maildir to mbox .. append all the files
- local @files = &get_maildir_files($src->{'file'});
- &open_tempfile(DEST, ">>$dest->{'file'}");
- local $fromline = &make_from_line("webmin\@example.com")."\n";
- foreach my $f (@files) {
- &open_readfile(SOURCE, $f);
- &print_tempfile("DEST", $fromline);
- while(read(SOURCE, $buf, 1024) > 0) {
- &print_tempfile(DEST, $buf);
- }
- close(SOURCE);
- }
- &close_tempfile(DEST);
- }
- else {
- # read in all mail and write out, in 100 message blocks
- local $max = &mailbox_folder_size($src);
- for(my $s=0; $s<$max; $s+=100) {
- local $e = $s+99;
- $e = $max-1 if ($e >= $max);
- local @mail = &mailbox_list_mails($s, $e, $src);
- local @want = @mail[$s..$e];
- &mailbox_copy_mail($src, $dest, @want);
- }
- }
- }
- # mailbox_move_mail(&source, &dest, mail, ...)
- # Move mail from one folder to another
- sub mailbox_move_mail
- {
- return undef if (&is_readonly_mode());
- local $src = shift(@_);
- local $dst = shift(@_);
- local $now = time();
- local $hn = &get_system_hostname();
- &create_folder_maildir($dst);
- local $fix_index;
- if (($src->{'type'} == 1 || $src->{'type'} == 3) && $dst->{'type'} == 1) {
- # Can just move mail files to Maildir names
- local $dd = $dst->{'file'};
- &create_folder_maildir($dst);
- foreach $m (@_) {
- rename($m->{'file'}, "$dd/cur/$now.$$.$hn");
- $now++;
- }
- &mailbox_fix_permissions($dst);
- $fix_index = 1;
- }
- elsif (($src->{'type'} == 1 || $src->{'type'} == 3) && $dst->{'type'} == 3) {
- # Can move and rename to MH numbering
- local $dd = $dst->{'file'};
- local $num = &max_mhdir($dst->{'file'}) + 1;
- foreach $m (@_) {
- rename($m->{'file'}, "$dd/$num");
- $num++;
- }
- &mailbox_fix_permissions($dst);
- $fix_index = 1;
- }
- else {
- # Append to new folder file, or create in folder directory
- my @mdel;
- my $r;
- my $save_read = &get_product_name() eq "usermin";
- foreach my $m (@_) {
- $r = &get_mail_read($src, $m) if ($save_read);
- my $mcopy = { %$m };
- &write_mail_folder($mcopy, $dst);
- &set_mail_read($dst, $mcopy, $r) if ($save_read);
- push(@mdel, $m);
- }
- local $src->{'notrash'} = 1; # Prevent saving to trash
- &mailbox_delete_mail($src, @mdel);
- }
- }
- # mailbox_fix_permissions(&folder, [&stat])
- # Set the ownership on all files in a folder correctly, either based on its
- # current stat or a structure passed in.
- sub mailbox_fix_permissions
- {
- local ($f, $st) = @_;
- $st ||= [ stat($f->{'file'}) ];
- return 0 if ($< != 0); # Only makes sense when running as root
- if ($f->{'type'} == 0) {
- # Set perms on a single file
- &set_ownership_permissions($st->[4], $st->[5], $st->[2], $f->{'file'});
- return 1;
- }
- elsif ($f->{'type'} == 1 || $f->{'type'} == 3) {
- # Do a whole directory
- &execute_command("chown -R $st->[4]:$st->[5] ".
- quotemeta($dst->{'file'}));
- return 1;
- }
- return 0;
- }
- # mailbox_move_folder(&source, &dest)
- # Moves all mail from one folder to another, possibly converting the type
- sub mailbox_move_folder
- {
- return undef if (&is_readonly_mode());
- local ($src, $dst) = @_;
- if ($src->{'type'} == $dst->{'type'} && !$src->{'remote'}) {
- # Can just move the file or dir
- local @st = stat($dst->{'file'});
- system("rm -rf ".quotemeta($dst->{'file'}));
- system("mv ".quotemeta($src->{'file'})." ".quotemeta($dst->{'file'}));
- if (@st) {
- &mailbox_fix_permissions($dst, \@st);
- }
- }
- elsif (($src->{'type'} == 1 || $src->{'type'} == 3) && $dst->{'type'} == 0) {
- # For Maildir or MH to mbox moves, just append files
- local @files = $src->{'type'} == 1 ? &get_maildir_files($src->{'file'})
- : &get_mhdir_files($src->{'file'});
- &open_tempfile(DEST, ">>$dst->{'file'}");
- local $fromline = &make_from_line("webmin\@example.com");
- foreach my $f (@files) {
- &open_readfile(SOURCE, $f);
- &print_tempfile("DEST", $fromline);
- while(read(SOURCE, $buf, 1024) > 0) {
- &print_tempfile(DEST, $buf);
- }
- &unlink_file($f);
- }
- &close_tempfile(DEST);
- }
- else {
- # Need to read in and write out. But do it in 1000-message blocks
- local $count = &mailbox_folder_size($src);
- local $step = 1000;
- for(my $start=0; $start<$count; $start+=$step) {
- local $end = $start + $step - 1;
- $end = $count-1 if ($end >= $count);
- local @mails = &mailbox_list_mails($start, $end, $src);
- @mails = @mails[$start..$end];
- &mailbox_copy_mail($src, $dst, @mails);
- }
- &mailbox_empty_folder($src);
- }
- # Delete source folder index
- if ($src->{'sortable'}) {
- &delete_new_sort_index($src);
- }
- }
- # mailbox_copy_mail(&source, &dest, mail, ...)
- # Copy mail from one folder to another
- sub mailbox_copy_mail
- {
- return undef if (&is_readonly_mode());
- local $src = shift(@_);
- local $dst = shift(@_);
- local $now = time();
- &create_folder_maildir($dst);
- if ($src->{'type'} == 6 && $dst->{'type'} == 6) {
- # Copying from one virtual folder to another, so just copy the
- # reference
- foreach my $m (@_) {
- push(@{$dst->{'members'}}, [ $m->{'subfolder'}, $m->{'subid'},
- $m->{'header'}->{'message-id'} ]);
- }
- }
- elsif ($dst->{'type'} == 6) {
- # Add this mail to the index of the virtual folder
- foreach my $m (@_) {
- push(@{$dst->{'members'}}, [ $src, $m->{'idx'},
- $m->{'header'}->{'message-id'} ]);
- }
- &save_folder($dst);
- }
- else {
- # Just write to destination folder. The read status is preserved, but
- # only if in Usermin.
- my $r;
- my $save_read = &get_product_name() eq "usermin";
- foreach my $m (@_) {
- $r = &get_mail_read($src, $m) if ($save_read);
- my $mcopy = { %$m };
- &write_mail_folder($mcopy, $dst);
- &set_mail_read($dst, $mcopy, $r) if ($save_read);
- }
- }
- }
- # folder_type(file_or_dir)
- sub folder_type
- {
- return -d "$_[0]/cur" ? 1 : -d $_[0] ? 3 : 0;
- }
- # create_folder_maildir(&folder)
- # Ensure that a maildir folder has the needed new, cur and tmp directories
- sub create_folder_maildir
- {
- mkdir($folders_dir, 0700);
- if ($_[0]->{'type'} == 1) {
- local $id = $_[0]->{'file'};
- mkdir($id, 0700);
- mkdir("$id/cur", 0700);
- mkdir("$id/new", 0700);
- mkdir("$id/tmp", 0700);
- }
- }
- # write_mail_folder(&mail, &folder, textonly)
- # Writes some mail message to a folder
- sub write_mail_folder
- {
- return undef if (&is_readonly_mode());
- &create_folder_maildir($_[1]);
- local $needid;
- if ($_[1]->{'type'} == 1) {
- # Add to a maildir directory. ID is set by write_maildir to the new
- # relative filename
- local $md = $_[1]->{'file'};
- &write_maildir($_[0], $md, $_[2]);
- }
- elsif ($_[1]->{'type'} == 3) {
- # Create a new MH file. ID is just the new message number
- local $num = &max_mhdir($_[1]->{'file'}) + 1;
- local $md = $_[1]->{'file'};
- local @st = stat($_[1]->{'file'});
- &send_mail($_[0], "$md/$num", $_[2], 1);
- if ($< == 0) {
- &set_ownership_permissions($st[4], $st[5], undef, "$md/$num");
- }
- $_[0]->{'id'} = $num;
- }
- elsif ($_[1]->{'type'} == 0) {
- # Just append to the folder file.
- &send_mail($_[0], $_[1]->{'file'}, $_[2], 1);
- $needid = 1;
- }
- elsif ($_[1]->{'type'} == 4) {
- # Upload to the IMAP server
- local @rv = &imap_login($_[1]);
- if ($rv[0] == 0) { &error($rv[1]); }
- elsif ($rv[0] == 3) { &error(&text('save_emailbox', $rv[1])); }
- elsif ($rv[0] == 2) { &error(&text('save_elogin2', $rv[1])); }
- local $h = $rv[1];
- # Create a temp file and use it to create the IMAP command
- local $temp = &transname();
- &send_mail($_[0], $temp, $_[2], 0, "dummy");
- local $text = &read_file_contents($temp);
- unlink($temp);
- $text =~ s/^From.*\r?\n//; # Not part of IMAP format
- @rv = &imap_command($h, sprintf "APPEND \"%s\" {%d}\r\n%s",
- $_[1]->{'mailbox'} || "INBOX", length($text), $text);
- &error(&text('save_eappend', $rv[3])) if (!$rv[0]);
- $needid = 1;
- }
- elsif ($_[1]->{'type'} == 5) {
- # Just append to the last subfolder
- local @sf = @{$_[1]->{'subfolders'}};
- &write_mail_folder($_[0], $sf[$#sf], $_[2]);
- $needid = 1;
- }
- elsif ($_[1]->{'type'} == 6) {
- # Add mail to first sub-folder, and to virtual index
- # XXX not done
- &error("Cannot add mail to virtual folders");
- }
- if ($needid) {
- # Get the ID of the new mail
- local @idlist = &mailbox_idlist($_[1]);
- print DEBUG "new idlist=",join(" ", @idlist),"\n";
- $_[0]->{'id'} = $idlist[$#idlist];
- }
- }
- # mailbox_modify_mail(&oldmail, &newmail, &folder, textonly)
- # Replaces some mail message with a new one
- sub mailbox_modify_mail
- {
- local ($oldmail, $mail, $folder, $textonly) = @_;
- return undef if (&is_readonly_mode());
- if ($folder->{'type'} == 1) {
- # Just replace the existing file
- &modify_maildir($oldmail, $mail, $textonly);
- }
- elsif ($folder->{'type'} == 3) {
- # Just replace the existing file
- &modify_mhdir($oldmail, $mail, $textonly);
- }
- elsif ($folder->{'type'} == 0) {
- # Modify the mail file
- &modify_mail($folder->{'file'}, $oldmail, $mail, $textonly);
- }
- elsif ($folder->{'type'} == 5 || $folder->{'type'} == 6) {
- # Modify in the underlying folder
- local ($oldsfn, $oldsid) = split(/\t+/, $oldmail->{'id'}, 2);
- local ($sfn, $sid) = split(/\t+/, $mail->{'id'}, 2);
- local $sf = &find_subfolder($folder, $sfn);
- $oldmail->{'id'} = $oldsid;
- $mail->{'id'} = $sid;
- &mailbox_modify_mail($oldmail, $mail, $sf, $textonly);
- $oldmail->{'id'} = $oldsfn."\t".$oldsid;
- $mail->{'id'} = $sfn."\t".$sid;
- }
- else {
- &error("Cannot modify mail in this type of folder!");
- }
- # Delete the message being modified from its index, to force re-generation
- # with new details
- $mail->{'id'} = $oldmail->{'id'}; # Assume that it will replace the old
- if ($folder->{'sortable'}) {
- &delete_new_sort_index_message($folder, $mail->{'id'});
- }
- }
- # mailbox_folder_size(&folder, [estimate])
- # Returns the number of messages in some folder
- sub mailbox_folder_size
- {
- if ($_[0]->{'type'} == 0) {
- # A mbox formatted file
- return &count_mail($_[0]->{'file'});
- }
- elsif ($_[0]->{'type'} == 1) {
- # A qmail maildir
- return &count_maildir($_[0]->{'file'});
- }
- elsif ($_[0]->{'type'} == 2) {
- # A POP3 server
- local @rv = &pop3_login($_[0]);
- if ($rv[0] != 1) {
- if ($rv[0] == 0) { &error($rv[1]); }
- else { &error(&text('save_elogin', $rv[1])); }
- }
- local @st = &pop3_command($rv[1], "stat");
- if ($st[0] == 1) {
- local ($count, $size) = split(/\s+/, $st[1]);
- return $count;
- }
- else {
- &error($st[1]);
- }
- }
- elsif ($_[0]->{'type'} == 3) {
- # An MH directory
- return &count_mhdir($_[0]->{'file'});
- }
- elsif ($_[0]->{'type'} == 4) {
- # An IMAP server
- local @rv = &imap_login($_[0]);
- if ($rv[0] != 1) {
- if ($rv[0] == 0) { &error($rv[1]); }
- elsif ($rv[0] == 3) { &error(&text('save_emailbox', $rv[1])); }
- elsif ($rv[0] == 2) { &error(&text('save_elogin2', $rv[1])); }
- }
- $_[0]->{'lastchange'} = $rv[3];
- return $rv[2];
- }
- elsif ($_[0]->{'type'} == 5) {
- # A composite folder - the size is just that of the sub-folders
- my $rv = 0;
- foreach my $sf (@{$_[0]->{'subfolders'}}) {
- $rv += &mailbox_folder_size($sf);
- }
- return $rv;
- }
- elsif ($_[0]->{'type'} == 6 && !$_[1]) {
- # A virtual folder .. we need to exclude messages that no longer
- # exist in the parent folders
- my $rv = 0;
- foreach my $msg (@{$_[0]->{'members'}}) {
- if (&mailbox_get_mail($msg->[0], $msg->[1])) {
- $rv++;
- }
- }
- return $rv;
- }
- elsif ($_[0]->{'type'} == 6 && $_[1]) {
- # A virtual folder .. but we can just use the last member count
- return scalar(@{$_[0]->{'members'}});
- }
- }
- # mailbox_folder_unread(&folder)
- # Returns the total messages in some folder, the number unread and the number
- # flagged as special.
- sub mailbox_folder_unread
- {
- local ($folder) = @_;
- if ($folder->{'type'} == 4) {
- # For IMAP, the server knows
- local @rv = &imap_login($folder);
- if ($rv[0] != 1) {
- return ( );
- }
- local @data = ( $rv[2] );
- local $h = $rv[1];
- foreach my $s ("UNSEEN", "FLAGGED") {
- @rv = &imap_command($h, "SEARCH ".$s);
- local ($srch) = grep { $_ =~ /^\*\s+SEARCH/i } @{$rv[1]};
- local @ids = split(/\s+/, $srch);
- shift(@ids); shift(@ids); # lose * SEARCH
- push(@data, scalar(@ids));
- }
- return @data;
- }
- elsif ($folder->{'type'} == 5) {
- # Composite folder - counts are sums of sub-folders
- local @data;
- foreach my $sf (@{$folder->{'subfolders'}}) {
- local @sfdata = &mailbox_folder_unread($sf);
- if (scalar(@sfdata)) {
- $data[0] += $sfdata[0];
- $data[1] += $sfdata[1];
- $data[2] += $sfdata[2];
- }
- }
- return @data;
- }
- 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);
- };
- return ( ) if ($@);
- foreach my $m (@mails) {
- local $rf = &get_mail_read($folder, $m);
- if ($rf == 2) {
- $data[2]++;
- }
- elsif ($rf == 0) {
- $data[1]++;
- }
- $data[0]++;
- }
- return @data;
- }
- }
- # mailbox_set_read_flags(&folder, &mail, read, special, replied)
- # Updates the status flags on some message
- sub mailbox_set_read_flag
- {
- local ($folder, $mail, $read, $special, $replied) = @_;
- if ($folder->{'type'} == 4) {
- # Set flags on IMAP server
- local @rv = &imap_login($folder);
- if ($rv[0] == 0) { &error($rv[1]); }
- elsif ($rv[0] == 3) { &error(&text('save_emailbox', $rv[1])); }
- elsif ($rv[0] == 2) { &error(&text('save_elogin2', $rv[1])); }
- local $h = $rv[1];
- foreach my $f ([ $read, "\\Seen" ],
- [ $special, "\\Flagged" ],
- [ $replied, "\\Answered" ]) {
- print DEBUG "setting '$f->[0]' '$f->[1]' for $mail->{'…
Large files files are truncated, but you can click here to view the full file