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
|
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);
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);
}
$mgr->closeAllFolders;
gzip($mbox_path, "$mbox_path.gz")
or die "gzip failed: $GzipError\n";
unlink $mbox_path if -e "$mbox_path.gz";
make_maildir_readonly($expanded_path);
}
sub expand_mbox {
my ($source_path, $expanded_path) = @_;
my $lockfile = $expanded_path . ".lock";
# check whether we got halfway there, or we finished it
if (-e $lockfile) {
remove_tree($expanded_path);
unlink $lockfile;
} elsif (-e $expanded_path) {
return;
}
# lock this one
open my $touch_fh, '>', $lockfile;
close $touch_fh;
# 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);
}
$mgr->closeAllFolders;
make_maildir_readonly($expanded_path);
# mark as done
unlink $lockfile;
# nuke the tempdir now to avoid running out of ramdisk if we're
# expanding a lot of mboxes
remove_tree($dir);
}
sub make_maildir_readonly {
chmod 0500, catfile($_[0], "cur"), catfile($_[0], "new"),
catfile($_[0], "tmp");
chmod 0400, glob "$_[0]/cur/* $_[0]/new/* $_[0]/tmp/*";
}
1;
|
