X-Git-Url: http://www.git.stargrave.org/?a=blobdiff_plain;f=lib%2FPublicInbox%2FWatchMaildir.pm;h=0e2a6d2c3c5d6f6ea50580b5ad8e25eb9314278f;hb=f9b70eb6ebbf96c2fe79ab2738ea4954c5a124f3;hp=f1a21b9b42d6cdaa9d7702305ba481c0410347a2;hpb=bf963d16a434f3aa9fe903e1299ac86852ecd3c6;p=public-inbox.git diff --git a/lib/PublicInbox/WatchMaildir.pm b/lib/PublicInbox/WatchMaildir.pm index f1a21b9b..0e2a6d2c 100644 --- a/lib/PublicInbox/WatchMaildir.pm +++ b/lib/PublicInbox/WatchMaildir.pm @@ -1,19 +1,58 @@ # Copyright (C) 2016 all contributors # License: AGPL-3.0+ +# +# ref: https://cr.yp.to/proto/maildir.html +# http://wiki2.dovecot.org/MailboxFormat/Maildir package PublicInbox::WatchMaildir; use strict; use warnings; -use Email::MIME; +use PublicInbox::MIME; use Email::MIME::ContentType; $Email::MIME::ContentType::STRICT_PARAMS = 0; # user input is imperfect use PublicInbox::Git; use PublicInbox::Import; use PublicInbox::MDA; +use PublicInbox::Spawn qw(spawn); +use File::Temp qw//; sub new { my ($class, $config) = @_; - my (%mdmap, @mdir); - foreach my $k (keys %$config) { + my (%mdmap, @mdir, $spamc, $spamdir); + + # "publicinboxwatch" is the documented namespace + # "publicinboxlearn" is legacy but may be supported + # indefinitely... + foreach my $pfx (qw(publicinboxwatch publicinboxlearn)) { + my $k = "$pfx.watchspam"; + if (my $dir = $config->{$k}) { + if ($dir =~ s/\Amaildir://) { + $dir =~ s!/+\z!!; + # skip "new", no MUA has seen it, yet. + my $cur = "$dir/cur"; + $spamdir = $cur; + push @mdir, $cur; + $mdmap{$cur} = 'watchspam'; + } else { + warn "unsupported $k=$dir\n"; + } + } + } + + my $k = 'publicinboxwatch.spamcheck'; + my $spamcheck = $config->{$k}; + if ($spamcheck) { + if ($spamcheck eq 'spamc') { + $spamcheck = 'PublicInbox::Spamcheck::Spamc'; + } + if ($spamcheck =~ /::/) { + eval "require $spamcheck"; + $spamcheck = _spamcheck_cb($spamcheck->new); + } else { + warn "unsupported $k=$spamcheck\n"; + $spamcheck = undef; + } + } + foreach $k (keys %$config) { $k =~ /\Apublicinbox\.([^\.]+)\.watch\z/ or next; my $name = $1; my $watch = $config->{$k}; @@ -27,8 +66,9 @@ sub new { my $new = "$watch/new"; my $cur = "$watch/cur"; push @mdir, $new, $cur; - $mdmap{$new} = $inbox; - $mdmap{$cur} = $inbox; + die "$new already in use\n" if $mdmap{$new}; + die "$cur already in use\n" if $mdmap{$cur}; + $mdmap{$new} = $mdmap{$cur} = $inbox; } else { warn "watch unsupported: $k=$watch\n"; } @@ -38,25 +78,99 @@ sub new { my $mdre = join('|', map { quotemeta($_) } @mdir); $mdre = qr!\A($mdre)/!; bless { + spamcheck => $spamcheck, + spamdir => $spamdir, mdmap => \%mdmap, mdir => \@mdir, mdre => $mdre, + config => $config, importers => {}, + opendirs => {}, # dirname => dirhandle (in progress scans) }, $class; } sub _done_for_now { - $_->done foreach values %{$_[0]->{importers}}; + my ($self) = @_; + my $opendirs = $self->{opendirs}; + + # spamdir scanning means every importer remains open + my $spamdir = $self->{spamdir}; + return if defined($spamdir) && $opendirs->{$spamdir}; + + foreach my $im (values %{$self->{importers}}) { + # not done if we're scanning + next if $opendirs->{$im->{git}->{git_dir}}; + $im->done; + } } sub _try_fsn_paths { - my ($self, $paths) = @_; - _try_path($self, $_->{path}) foreach @$paths; + my ($self, $scan_re, $paths) = @_; + foreach (@$paths) { + my $path = $_->{path}; + if ($path =~ $scan_re) { + scan($self, $path); + } else { + _try_path($self, $path); + } + } _done_for_now($self); } +sub _remove_spam { + my ($self, $path) = @_; + # path must be marked as (S)een + $path =~ /:2,[A-R]*S[T-Za-z]*\z/ or return; + my $mime = _path_to_mime($path) or return; + _force_mid($mime); + $self->{config}->each_inbox(sub { + my ($ibx) = @_; + eval { + my $im = _importer_for($self, $ibx); + $im->remove($mime); + if (my $scrub = _scrubber_for($ibx)) { + my $scrubbed = $scrub->scrub($mime) or return; + $scrubbed == 100 and return; + $im->remove($scrubbed); + } + }; + if ($@) { + warn "error removing spam at: ", $path, + " from ", $ibx->{name}, ': ', $@, "\n"; + } + }) +} + +# used to hash the relevant portions of a message when there are conflicts +sub _hash_mime2 { + my ($mime) = @_; + require Digest::SHA; + my $dig = Digest::SHA->new('SHA-1'); + $dig->add($mime->header_obj->header_raw('Subject')); + $dig->add($mime->body_raw); + $dig->hexdigest; +} + +sub _force_mid { + my ($mime) = @_; + # probably a bad idea, but we inject a Message-Id if + # one is missing, here.. + my $mid = $mime->header_obj->header_raw('Message-Id'); + if (!defined $mid || $mid =~ /\A\s*\z/) { + $mid = '<' . _hash_mime2($mime) . '@generated>'; + $mime->header_set('Message-Id', $mid); + } +} + sub _try_path { my ($self, $path) = @_; + my @p = split(m!/+!, $path); + return if $p[-1] !~ /\A[a-zA-Z0-9][\w:,=\.]+\z/; + if ($p[-1] =~ /:2,([A-Z]+)\z/i) { + my $flags = $1; + return if $flags =~ /[DT]/; # no [D]rafts or [T]rashed mail + } + return unless -f $path; if ($path !~ $self->{mdre}) { warn "unrecognized path: $path\n"; return; @@ -66,78 +180,152 @@ sub _try_path { warn "unmappable dir: $1\n"; return; } - my $im = $inbox->{-import} ||= eval { - my $git = $inbox->git; - my $name = $inbox->{name}; - my $addr = $inbox->{-primary_address}; - PublicInbox::Import->new($git, $name, $addr); - }; - $self->{importers}->{"$im"} = $im; - my $mime; + if (!ref($inbox) && $inbox eq 'watchspam') { + return _remove_spam($self, $path); + } + my $im = _importer_for($self, $inbox); + my $mime = _path_to_mime($path) or return; + $mime->header_set($_) foreach @PublicInbox::MDA::BAD_HEADERS; + my $wm = $inbox->{-watchheader}; + if ($wm) { + my $v = $mime->header_obj->header_raw($wm->[0]); + return unless ($v && $v =~ $wm->[1]); + } + if (my $scrub = _scrubber_for($inbox)) { + my $ret = $scrub->scrub($mime) or return; + $ret == 100 and return; + $mime = $ret; + } + + _force_mid($mime); + $im->add($mime, $self->{spamcheck}); +} + +sub quit { $_[0]->{quit} = 1 } + +sub watch { + my ($self) = @_; + my $scan = File::Temp->newdir("public-inbox-watch.$$.scan.XXXXXX", + TMPDIR => 1); + my $scandir = $self->{scandir} = $scan->dirname; + my $re = qr!\A$scandir/!; + my $cb = sub { _try_fsn_paths($self, $re, \@_) }; + + # lazy load here, we may support watching via IMAP IDLE + # in the future... + require Filesys::Notify::Simple; + my $fsn = Filesys::Notify::Simple->new([@{$self->{mdir}}, $scandir]); + $fsn->wait($cb) until ($self->{quit}); +} + +sub trigger_scan { + my ($self, $base) = @_; + my $dir = $self->{scandir} or die "not watch-ing, yet\n"; + open my $fh, '>', "$dir/$base" or die "open $dir/$base failed: $!\n"; + close $fh or die "close $dir/$base failed: $!\n"; +} + +sub scan { + my ($self, $path) = @_; + my $max = 10; + my $opendirs = $self->{opendirs}; + my @dirnames = keys %$opendirs; + foreach my $dir (@dirnames) { + my $dh = delete $opendirs->{$dir}; + my $n = $max; + while (my $fn = readdir($dh)) { + _try_path($self, "$dir/$fn"); + last if --$n < 0; + } + $opendirs->{$dir} = $dh if $n < 0; + } + if ($path =~ /full\z/) { + foreach my $dir (@{$self->{mdir}}) { + next if $opendirs->{$dir}; # already in progress + my $ok = opendir(my $dh, $dir); + unless ($ok) { + warn "failed to open $dir: $!\n"; + next; + } + my $n = $max; + while (my $fn = readdir($dh)) { + _try_path($self, "$dir/$fn"); + last if --$n < 0; + } + $opendirs->{$dir} = $dh if $n < 0; + } + } + if (keys %$opendirs) { # do we have more work to do? + trigger_scan($self, 'cont'); + } else { + _done_for_now($self); + } +} + +sub _path_to_mime { + my ($path) = @_; if (open my $fh, '<', $path) { local $/; my $str = <$fh>; $str or return; - $mime = Email::MIME->new(\$str); + return PublicInbox::MIME->new(\$str); } elsif ($!{ENOENT}) { return; } else { warn "failed to open $path: $!\n"; return; } +} - $mime->header_set($_) foreach @PublicInbox::MDA::BAD_HEADERS; - my $wm = $inbox->{-watchheader}; - if ($wm) { - my $v = $mime->header_obj->header_raw($wm->[0]); - return unless ($v && $v =~ $wm->[1]); +sub _importer_for { + my ($self, $inbox) = @_; + my $im = $inbox->{-import} ||= eval { + my $git = $inbox->git; + my $name = $inbox->{name}; + my $addr = $inbox->{-primary_address}; + PublicInbox::Import->new($git, $name, $addr, $inbox); + }; + + my $importers = $self->{importers}; + if (scalar(keys(%$importers)) > 2) { + delete $importers->{"$im"}; + _done_for_now($self); } + + $importers->{"$im"} = $im; +} + +sub _scrubber_for { + my ($inbox) = @_; my $f = $inbox->{filter}; if ($f && $f =~ /::/) { + my @args = (-inbox => $inbox); + # basic line splitting, only + # Perhaps we can have proper quote splitting one day... + ($f, @args) = split(/\s+/, $f) if $f =~ /\s+/; + eval "require $f"; if ($@) { warn $@; } else { - $f = $f->new; - $mime = $f->scrub($mime); + # e.g: PublicInbox::Filter::Vger->new(@args) + return $f->new(@args); } } - $mime or return; - my $mid = $mime->header_obj->header_raw('Message-Id'); - $im->add($mime); -} - -sub watch { - my ($self) = @_; - my $cb = sub { _try_fsn_paths($self, \@_) }; - my $mdir = $self->{mdir}; - - require Filesys::Notify::Simple; - my $watcher = Filesys::Notify::Simple->new($mdir); - $watcher->wait($cb) while (1); + undef; } -sub scan { - my ($self) = @_; - my $mdir = $self->{mdir}; - foreach my $dir (@$mdir) { - my $ok = opendir(my $dh, $dir); - unless ($ok) { - warn "failed to open $dir: $!\n"; - next; - } - while (my $fn = readdir($dh)) { - next unless $fn =~ /\A[a-zA-Z0-9][\w:,=\.]+\z/; - $fn = "$dir/$fn"; - if (-f $fn) { - _try_path($self, $fn); - } else { - warn "not a file: $fn\n"; - } +sub _spamcheck_cb { + my ($sc) = @_; + sub { + my ($mime) = @_; + my $tmp = ''; + if ($sc->spamcheck($mime, \$tmp)) { + return PublicInbox::MIME->new(\$tmp); } - closedir $dh; + warn $mime->header('Message-ID')." failed spam check\n"; + undef; } - _done_for_now($self); } 1;