mbsyncloop

#!/usr/bin/env perl
use 5.016;
use strict;
use warnings;

use File::Path;
use File::Spec;
use File::Temp;
use JSON::PP;
use POSIX 'mkfifo';

my $RUN_DIR = make_run_dir();
my ($PW_PID, $GOIMAPNOTIFY_PID);

$SIG{INT} = $SIG{TERM} = sub { cleanup(); exit };
END { cleanup() }

my $config = "$ENV{HOME}/.config/mbsyncloop/config.json";

main($config);

sub main {
    my ($config) = @_;

    my $pw_pipe = make_pw_pipe();
    my $password_command_pipe = "head -n1 '$pw_pipe'";

    my $config_data;
    if (-f $config) {
        $config_data = JSON::PP::decode_json(slurp($config));
    }
    else {
        $config_data = {};
    }

    my $mbsync_config_data = slurp(
        ($config_data->{mbsync_config} // '~/.mbsyncrc')
            =~ s{^~/}{$ENV{HOME}/}r
    );
    my $password_command = extract_password_command($mbsync_config_data);

    spawn_pw_proc($pw_pipe, $password_command);

    my $goimapnotify_config_data = extract_goimapnotify_config(
        $config_data,
        $mbsync_config_data,
        $password_command_pipe,
    );

    my $goimapnotify_r = spawn_goimapnotify_proc(
        $goimapnotify_config_data,
    );

    my $generated_mbsync_config_file = write_mbsync_config(
        $mbsync_config_data,
        $goimapnotify_config_data->{boxes},
        $password_command_pipe,
    );

    loop(
        $config_data,
        $generated_mbsync_config_file,
        $goimapnotify_r,
    );
}

sub make_pw_pipe {
    my $file = File::Spec->catfile($RUN_DIR, "mbsyncloop");
    unlink($file);
    mkfifo($file, 0700) or die "couldn't create $file: $!";
    $file
}

sub extract_goimapnotify_config {
    my ($config_data, $mbsync_config_data, $password_command) = @_;

    (my $host) = $mbsync_config_data =~ /^Host (.*)$/m;
    (my $port) = $mbsync_config_data =~ /^Port (.*)$/m;
    (my $user) = $mbsync_config_data =~ /^User (.*)$/m;

    my $tls;
    if ($mbsync_config_data =~ /SSLType\s+IMAPS/) {
        $tls = JSON::PP::true;
        $port //= 993;
    }
    else {
        $tls = JSON::PP::false;
        $port //= 143;
    }

    my $goimapnotify_config = {
        host => $host,
        port => $port,
        tls => $tls,
        username => $user,
        passwordCmd => $password_command,
    };

    my @mailboxes;
    if ($config_data->{boxes}) {
        @mailboxes = @{ $config_data->{boxes} };
    }
    else {
        @mailboxes = read_mailboxes($goimapnotify_config);
        if ($config_data->{box_patterns}) {
            @mailboxes = grep {
                my $mailbox = $_;
                grep {
                    $mailbox =~ /$_/
                } @{ $config_data->{box_patterns} }
            } @mailboxes
        }
    }

    $goimapnotify_config->{onNewMail} = "echo new";
    $goimapnotify_config->{boxes} = \@mailboxes;

    $goimapnotify_config
}

sub read_mailboxes {
    my ($config) = @_;

    my $tmp = File::Temp->new(DIR => $RUN_DIR);
    $tmp->print(JSON::PP::encode_json($config));
    $tmp->flush;
    open my $fh, '-|', 'goimapnotify', '--conf', $tmp->filename, '--list'
        or die "couldn't run goimapnotify: $!";
    <$fh>;

    map { chomp; s/^[^ ]* //r } <$fh>
}

sub extract_password_command {
    my ($mbsync_config) = @_;
    (my $password_command) = $mbsync_config =~ /^PassCmd "(.*)"$/m;
    $password_command
}

sub spawn_pw_proc {
    my ($pw_pipe, $password_command) = @_;

    my $pw = fetch_password($password_command);

    $PW_PID = fork;
    die "fork failed: $!" unless defined $PW_PID;
    if (!$PW_PID) {
        $SIG{PIPE} = 'IGNORE';
        setpgrp(0, 0);
        while (1) {
            open my $fh, '>', $pw_pipe or die "couldn't open $pw_pipe";
            $fh->print("$pw\n");
            close $fh;
        }
    }
}

sub fetch_password {
    my ($password_command) = @_;
    my $pw = `$password_command`;
    die "failed to fetch password: command returned $?" if $?;
    $pw
}

sub spawn_goimapnotify_proc {
    my ($config) = @_;

    pipe(my $goimapnotify_r, my $goimapnotify_w)
        or die "failed to create unnamed pipe: $!";

    $GOIMAPNOTIFY_PID = fork;
    die "fork failed: $!" unless defined $GOIMAPNOTIFY_PID;
    if (!$GOIMAPNOTIFY_PID) {
        setpgrp(0, 0);
        close $goimapnotify_r;

        my $tmp = File::Temp->new(DIR => $RUN_DIR);
        $tmp->print(JSON::PP::encode_json($config));
        $tmp->flush;

        while (1) {
            open my $fh, '-|', 'goimapnotify', '--conf', $tmp->filename
                or die "couldn't run goimapnotify: $!";
            while (<$fh>) {
                $goimapnotify_w->print("N\n");
                $goimapnotify_w->flush;
            }
        }
    }
    close $goimapnotify_w;

    $goimapnotify_r
}

sub write_mbsync_config {
    my ($mbsync_config, $mailboxes, $password_command) = @_;

    $mbsync_config =~ s/^PassCmd .*$/PassCmd "$password_command"/m;
    my ($far) = $mbsync_config =~ /^IMAPStore (.*)$/m;
    my ($near) = $mbsync_config =~ /^MaildirStore (.*)$/m;

    my $patterns = join "\n", map { "Pattern $_" } @$mailboxes;
    my $mbsync_channels = <<EOF;
Channel mbsyncloop_priority
Far :$far:
Near :$near:
Sync Pull Push
$patterns

Channel mbsyncloop_all
Far :$far:
Near :$near:
Sync Pull Push
Patterns *
EOF

    my $tmp = File::Temp->new(DIR => $RUN_DIR);
    $tmp->print($mbsync_config);
    $tmp->print("\n");
    $tmp->print($mbsync_channels);
    $tmp->flush;

    $tmp
}

sub loop {
    my ($config_data, $mbsync_config, $goimapnotify_r) = @_;

    my $poll_interval = $config_data->{poll_interval} // 15 * 60;
    my $last_all = 0;
    $SIG{HUP} = sub { $last_all = 0 };
    while (1) {
        my $now = time;
        if (($now - $last_all) >= $poll_interval) {
            sync(
                $mbsync_config,
                "mbsyncloop_all",
                $config_data->{on_new_mail},
            );
            $last_all = $now;
        }
        if (idle($goimapnotify_r, $poll_interval)) {
            sync(
                $mbsync_config,
                "mbsyncloop_priority",
                $config_data->{on_new_mail},
            );
        }
    }
}

sub sync {
    my ($config, $channel, $on_new_mail) = @_;
    my $config_file = $config->filename;
    while (1) {
        my $status = system("mbsync -c '$config_file' $channel");
        if (!$status) {
            system($on_new_mail) if defined $on_new_mail;
            last;
        }
        sleep 5;
    }
}

sub idle {
    my ($goimapnotify_r, $max_delay) = @_;
    my $rin = '';
    vec($rin, fileno($goimapnotify_r), 1) = 1;
    my $ready = select(my $rout = $rin, undef, undef, $max_delay);
    return 0 if $ready == -1 && $! == POSIX::EINTR;
    die "failed to read goimapnotify output: $!" if $ready == -1;
    if ($ready) {
        while (1) {
            my $ready = select(my $rout = $rin, undef, undef, 0.01);
            return 0 if $ready == -1 && $! == POSIX::EINTR;
            die "failed to read goimapnotify output: $!" if $ready == -1;
            last unless $ready;
            sysread $goimapnotify_r, my $data, 4096;
        }
        return 1;
    }
    return 0;
}

sub slurp {
    my ($file) = @_;
    local $/;
    open my $fh, '<', $file or die "couldn't open $file: $!";
    <$fh>
}

sub make_run_dir {
    my $dir = "/run/user/$>";
    if (!-d $dir) {
        $dir = File::Spec->tmpdir();
    }
    unlink File::Spec->catfile($dir, "mbsyncloop");
    mkdir File::Spec->catfile($dir, "mbsyncloop");
    mkdir File::Spec->catfile($dir, "mbsyncloop", $$);
    File::Spec->catfile($dir, "mbsyncloop", $$)
}

sub cleanup {
    kill KILL => -$PW_PID if $PW_PID;
    kill KILL => -$GOIMAPNOTIFY_PID if $GOIMAPNOTIFY_PID;
    File::Path::remove_tree($RUN_DIR) if $RUN_DIR;
}