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.

5 files changed, 166 insertions, 189 deletions

diff --git a/.config/notmuch/default/hooks/pre-new b/.config/notmuch/default/hooks/pre-new
index 302651d8..ec132832 100755
--- a/.config/notmuch/default/hooks/pre-new
+++ b/.config/notmuch/default/hooks/pre-new
@@ -5,4 +5,4 @@
 offline || movemymail
 
 # ensure that notmuch is able to detect renames by archive-fmail-to-annex
-ionice -c 3 expand-annex-mboxes
+ionice -c 3 ~/src/dotfiles/scripts/mail/expand-annex-to-fmail
diff --git a/bin/expand-annex-mboxes b/bin/expand-annex-mboxes
deleted file mode 100755
index 7800f021..00000000
--- a/bin/expand-annex-mboxes
+++ /dev/null
@@ -1,33 +0,0 @@
-#!/usr/bin/perl
-
-use 5.028;
-use strict;
-use warnings;
-use lib "$ENV{HOME}/src/dotfiles/perl5";
-
-use Fcntl qw(LOCK_EX LOCK_NB);
-use File::Path qw(make_path);
-use File::Spec::Functions qw(splitpath);
-use Local::Homedir::Mail qw(expand_mbox);
-
-# CONFIG
-
-our $mboxes   = "$ENV{HOME}/annex/mail";
-our $expanded = "$ENV{HOME}/.fmail/annex";
-
-# CODE
-
-# flock ourselves to ensure that only one copy of this script is ever running
-open our $us, "<", $0 or die $!;
-exit 0 unless glob "$mboxes/*.gz" and flock $us, LOCK_EX|LOCK_NB;
-
-make_path($expanded);
-open my $touch_fh, '>', "$expanded/.duplicity-ignore";
-close $touch_fh;
-
-foreach my $mbox (glob "$mboxes/*.gz") {
-    # $mbox might be a dangling symlink on this machine
-    next unless -e $mbox;
-
-    expand_mbox($mbox, $expanded);
-}
diff --git a/perl5/Local/Homedir/Mail.pm b/perl5/Local/Homedir/Mail.pm
deleted file mode 100644
index 68fc6036..00000000
--- a/perl5/Local/Homedir/Mail.pm
+++ /dev/null
@@ -1,140 +0,0 @@
-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,
-        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',
-        type      => 'mbox'
-    );
-    my $expanded = $mgr->open(
-        $expanded_path,
-        access    => 'a',
-        create    => 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;
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;
+}