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
|
#!/usr/bin/perl
# Copyright (C) 2019, 2022 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 Fcntl qw(LOCK_EX LOCK_NB);
use File::Path qw(make_path remove_tree);
use File::Temp qw(tempdir);
use File::Spec::Functions qw(catfile splitpath);
use IO::Uncompress::Gunzip qw(gunzip $GunzipError);
use Mail::Box::Manager;
our $mboxes = "$ENV{HOME}/annex/mail";
our $fmail_annex = "$ENV{HOME}/.fmail/annex";
open our $us, "<", $0 or die $!;
exit unless <$mboxes/*.gz> and flock $us, LOCK_EX | LOCK_NB;
-e or mkdir
for $fmail_annex, map catfile($fmail_annex, $_),
".expanded", "cur", "new", "tmp";
open my $touch_fh, ">", catfile $fmail_annex, ".duplicity-ignore";
my $mgr = Mail::Box::Manager->new;
foreach my $mbox (<$mboxes/*.gz>) {
# $mbox might be a dangling symlink on this machine.
-e $mbox or next;
my $mbox_name = substr +(splitpath $mbox)[2], 0, -3;
my $temp_maildir = catfile $fmail_annex, ".$mbox_name";
my $donefile = catfile $fmail_annex, ".expanded", $mbox_name;
# Check whether we finished, or got partway there.
next if -e $donefile;
remove_tree $temp_maildir if -e $temp_maildir;
# Unzip to (what is hopefully) a tmpfs, because Mail::Box can accept a
# path to only an unzipped mbox.
my $temp_dir = tempdir CLEANUP => 1, DIR => "/tmp";
chmod 0700, $temp_dir;
my $temp_mbox = catfile $temp_dir, "unzip.mbox";
gunzip $mbox, $temp_mbox or die "gunzip failed: $GunzipError\n";
my $temp_mbox_handle
= $mgr->open($temp_mbox, access => "r", type => "mbox");
my $temp_maildir_handle = $mgr->open(
$temp_maildir,
access => "a",
type => "maildir",
create => 1
);
for (@$temp_mbox_handle) {
$_->label(flagged => 0, seen => 1);
$mgr->copyMessage($temp_maildir_handle, $_);
}
$temp_mbox_handle->close(write => "NEVER");
$temp_maildir_handle->acceptMessages;
$temp_maildir_handle->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 $temp_maildir, "cur";
while (readdir $dirh) {
my $s = catfile $temp_maildir, "cur", $_;
-f $s and rename $s, catfile $fmail_annex, "cur", $_;
}
open my $touch_fh, ">", $donefile;
remove_tree $temp_dir;
remove_tree $temp_maildir;
}
|
