tidy up to-mbox and from-mbox scripts

Additionally, archive-fmail-to-annex creates ~/.fmail/annex if missing, and
expand-annex-to-fmail creates ~/.fmail/annex/.expanded before trying to create
files under that directory.

2 files changed, 165 insertions, 15 deletions

diff --git a/scripts/mail/archive-fmail-to-annex b/scripts/mail/archive-fmail-to-annex
index d9cfac17..b2713c8a 100755
--- a/scripts/mail/archive-fmail-to-annex
+++ b/scripts/mail/archive-fmail-to-annex
@@ -1,20 +1,36 @@
 #!/usr/bin/perl
 
+# 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 lib "$ENV{HOME}/src/dotfiles/perl5";
+use constant THIRTYONE => 31 * 24 * 60 * 60;
 
-use Local::Homedir::Mail qw(archive_to_mbox);
-use File::Spec::Functions qw(catfile);
+use File::Spec::Functions qw(catfile splitpath);
 use POSIX qw(strftime);
+use IO::Compress::Gzip qw(gzip $GzipError);
+use Mail::Box::Manager;
 
 # CONFIG
 
-our $maildirs        = "$ENV{HOME}/.fmail";
-our $mboxes          = "$ENV{HOME}/annex/mail";
-our $expanded_mboxes = "$ENV{HOME}/.fmail/annex";
-our %names = (inbox => 'archive', sent => 'sent');
+our $maildirs           = "$ENV{HOME}/.fmail";
+our $mboxes             = "$ENV{HOME}/annex/mail";
+our $fmail_annex        = "$ENV{HOME}/.fmail/annex";
+our %names              = (inbox => 'archive', sent => 'sent');
 our @annex_sync_remotes = qw(origin cloud);
 
 # CODE
@@ -23,23 +39,68 @@ our @annex_sync_remotes = qw(origin cloud);
 system "pgrep -u $ENV{USER} mbsync";
 die "mbsync is running" if $? == 0;
 
-die "no source!"         unless -d $maildirs;
 die "no dest!"           unless -d $mboxes;
-die "no expansion dest!" unless -d $expanded_mboxes;
+die "no source!"         unless -d $maildirs;
 
 system "movemymail";
 system "touch $ENV{HOME}/.nomovemymail";
 
+-e or mkdir
+  for $fmail_annex, map catfile($fmail_annex, $_), "cur", "new", "tmp";
+open my $touch_fh, ">", catfile $fmail_annex, ".duplicity-ignore";
+
 my $suffix = lc strftime("-%b-%Y", localtime);
 my @gzipped_mboxes;
 foreach my $name (keys %names) {
-    my $target = $names{$name} . $suffix;
-    archive_to_mbox(
-        catfile($maildirs, $name),
-        catfile($mboxes,   $target),
-        $expanded_mboxes
+    my $source      = catfile $maildirs, $name;
+    my $target_name = $names{$name} . $suffix;
+    my $target      = catfile $mboxes, $target_name;
+    my $target_gz   = "$target.gz";
+
+    # 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 to $target but $target_gz already exists\n"
+      if -e $target_gz;
+
+    # Each loop iteration 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_handle = $mgr->open(
+        $source,
+        access    => "rw",
+        create    => 0,
+        keep_dups => 1,
+        type      => "maildir"
+    );
+    my $target_handle = $mgr->open(
+        $target,
+        access    => "a",
+        create    => 1,
+        keep_dups => 1,
+        type      => "mbox"
     );
-    push @gzipped_mboxes, $target . ".gz";
+    my $fmail_annex_handle
+      = $mgr->open($fmail_annex, access => "a", type => "maildir");
+
+    my $now = time;
+    for (@$source) {
+	$now - $_->timestamp > THIRTYONE or next;
+	$_->label("seen") or next;
+	$_->label("flagged") and next;
+
+	$mgr->copyMessage($fmail_annex_handle, $_);
+	$mgr->moveMessage($target_handle, $_);
+    }
+    $fmail_annex_handle->acceptMessages;
+    $mgr->closeAllFolders;
+    open my $touch_fh, ">",
+      catfile $fmail_annex, ".expanded", $target_name;
+
+    gzip $target, $target_gz or die "gzip failed: $GzipError\n";
+    -e $target_gz and unlink $target;
+    push @gzipped_mboxes, $target_gz;
 }
 
 chdir $mboxes;
diff --git a/scripts/mail/expand-annex-to-fmail b/scripts/mail/expand-annex-to-fmail
new file mode 100755
index 00000000..a0985283
--- /dev/null
+++ b/scripts/mail/expand-annex-to-fmail
@@ -0,0 +1,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;
+}