1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
|
package Local::Homedir::Mail;
# Copyright (C) 2019 Sean Whitton
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
use 5.028;
use strict;
use warnings;
use constant THIRTYONE => 31 * 24 * 60 * 60;
use File::Spec::Functions qw(catfile splitpath);
use File::Temp qw(tempdir);
use File::Path qw(remove_tree);
use IO::Compress::Gzip qw(gzip $GzipError);
use IO::Uncompress::Gunzip qw(gunzip $GunzipError);
use Mail::Box::Manager;
use Exporter 'import';
our @EXPORT_OK = qw( archive_to_mbox expand_mbox );
sub archive_to_mbox {
my ($source_path, $mbox_path, $expanded_path) = @_;
# bail out if compressed mbox exists: that means this month's
# archive has already happened. it's okay to append to a
# not-yet-compressed mbox, as that probably means that the
# archival process was interrupted
die
"wanted to archive $source_path to $mbox_path but $mbox_path.gz already exists"
if -e "$mbox_path.gz";
# each invocation of the archive subroutine has its own
# Mail::Box::Manager because we want to call closeAllFolders and
# thereby perform all the moves and copies
my $mgr = Mail::Box::Manager->new();
my $source
= $mgr->open($source_path, access => 'rw', create => 0, keep_dups => 1);
my $mbox = $mgr->open(
$mbox_path,
access => 'a',
create => 1,
keep_dups => 1,
type => 'mbox'
);
my $expanded = $mgr->open(
$expanded_path,
access => 'a',
create => 1,
keep_dups => 1,
type => 'maildir',
);
my $now = time();
foreach my $message ($source->messages()) {
next unless $now - $message->timestamp > THIRTYONE;
next unless $message->label('seen');
next if $message->label('flagged');
$mgr->copyMessage($expanded, $message);
$mgr->moveMessage($mbox, $message);
}
$expanded->acceptMessages;
$mgr->closeAllFolders;
open my $touch_fh, ">",
catfile($expanded_path, ".expanded", (splitpath $mbox_path)[2]);
gzip($mbox_path, "$mbox_path.gz")
or die "gzip failed: $GzipError\n";
unlink $mbox_path if -e "$mbox_path.gz";
}
sub expand_mbox {
my ($source_path, $target) = @_;
(my $source_name = (splitpath $source_path)[2]) =~ s/\.gz$//;
my $expanded_path = catfile $target, ".$source_name";
my $donefile = catfile $target, ".expanded", $source_name;
# Check whether we finished, or got partway there.
return if -e $donefile;
remove_tree($expanded_path) if -e $expanded_path;
-e or mkdir for $target, map catfile($target, $_), "cur", "new", "tmp";
# unzip it to (what is hopefully a) tmpfs, since Mail::Box can
# only accept a path to an unzipped mbox
my $dir = tempdir(CLEANUP => 1, DIR => "/tmp");
chmod 0700, $dir;
my $unzipped = catfile($dir, "unzip.mbox");
gunzip($source_path, $unzipped) or die "gunzip failed: $GunzipError\n";
my $mgr = Mail::Box::Manager->new();
my $source = $mgr->open(
$unzipped,
access => 'r',
keep_dups => 1,
type => 'mbox'
);
my $expanded = $mgr->open(
$expanded_path,
access => 'a',
create => 1,
keep_dups => 1,
type => 'maildir'
);
foreach my $message ($source->messages()) {
$message->label(flagged => 0, seen => 1);
$mgr->copyMessage($expanded, $message);
}
$source->close(write => "NEVER");
$expanded->acceptMessages;
$expanded->close;
# Now we move all the files the old fashioned way, so that it's fast.
# It's safe because the filenames begin with a timestamp, so there really
# oughtn't be any collisions, and in any case this whole thing is a cache.
opendir my $dirh, catfile $expanded_path, "cur";
while (readdir $dirh) {
my $s = catfile $expanded_path, "cur", $_;
-f $s and rename $s, catfile $target, "cur", $_;
}
open my $touch_fh, ">", $donefile;
# nuke the tempdir now to avoid running out of ramdisk if we're
# expanding a lot of mboxes
remove_tree($dir);
remove_tree($expanded_path);
}
1;
|
