#!/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 = <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; }