X-Git-Url: http://www.git.stargrave.org/?p=public-inbox.git;a=blobdiff_plain;f=lib%2FPublicInbox%2FWatchMaildir.pm;h=08b1aab43ad1e8a4f6b06e6def310a4ecfb29eb0;hp=f34419a399005b6bbbfb7bbb27cb9a22442519fe;hb=7e881ac8227d1882c92de6f6701ffcba7cef9191;hpb=4e6710183bc331020a406077a1873f2713973f07 diff --git a/lib/PublicInbox/WatchMaildir.pm b/lib/PublicInbox/WatchMaildir.pm index f34419a3..08b1aab4 100644 --- a/lib/PublicInbox/WatchMaildir.pm +++ b/lib/PublicInbox/WatchMaildir.pm @@ -1,4 +1,4 @@ -# Copyright (C) 2016 all contributors +# Copyright (C) 2016-2019 all contributors # License: AGPL-3.0+ # # ref: https://cr.yp.to/proto/maildir.html @@ -6,67 +6,84 @@ package PublicInbox::WatchMaildir; use strict; use warnings; -use Email::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::MIME; use PublicInbox::Spawn qw(spawn); +use PublicInbox::InboxWritable; +use File::Temp qw//; +use PublicInbox::Filter::Base; +use PublicInbox::Spamcheck; +*REJECT = *PublicInbox::Filter::Base::REJECT; sub new { my ($class, $config) = @_; my (%mdmap, @mdir, $spamc); + my %uniq; - # XXX is "publicinboxlearn" really a good namespace for this? - my $k = 'publicinboxlearn.watchspam'; - if (my $spamdir = $config->{$k}) { - if ($spamdir =~ s/\Amaildir://) { - $spamdir =~ s!/+\z!!; - # skip "new", no MUA has seen it, yet. - my $cur = "$spamdir/cur"; - push @mdir, $cur; - $mdmap{$cur} = 'watchspam'; - } else { - warn "unsupported $k=$spamdir\n"; - } - } + # "publicinboxwatch" is the documented namespace + # "publicinboxlearn" is legacy but may be supported + # indefinitely... + foreach my $pfx (qw(publicinboxwatch publicinboxlearn)) { + my $k = "$pfx.watchspam"; + defined(my $dirs = $config->{$k}) or next; + $dirs = [ $dirs ] if !ref($dirs); + for my $dir (@$dirs) { + if (is_maildir($dir)) { + # skip "new", no MUA has seen it, yet. + my $cur = "$dir/cur"; + my $old = $mdmap{$cur}; + if (ref($old)) { + foreach my $ibx (@$old) { + warn <<""; +"$cur already watched for `$ibx->{name}' - $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; + } + die; + } + push @mdir, $cur; + $uniq{$cur}++; + $mdmap{$cur} = 'watchspam'; + } else { + warn "unsupported $k=$dir\n"; + } } } - foreach $k (keys %$config) { - $k =~ /\Apublicinbox\.([^\.]+)\.watch\z/ or next; - my $name = $1; - my $watch = $config->{$k}; - if ($watch =~ s/\Amaildir://) { - $watch =~ s!/+\z!!; - my $inbox = $config->lookup_name($name); - if (my $wm = $inbox->{watchheader}) { - my ($k, $v) = split(/:/, $wm, 2); - $inbox->{-watchheader} = [ $k, qr/\Q$v\E/ ]; + + my $k = 'publicinboxwatch.spamcheck'; + my $default = undef; + my $spamcheck = PublicInbox::Spamcheck::get($config, $k, $default); + $spamcheck = _spamcheck_cb($spamcheck) if $spamcheck; + + $config->each_inbox(sub { + # need to make all inboxes writable for spam removal: + my $ibx = $_[0] = PublicInbox::InboxWritable->new($_[0]); + + my $watch = $ibx->{watch} or return; + if (is_maildir($watch)) { + my $watch_hdrs = []; + if (my $wh = $ibx->{watchheader}) { + my ($k, $v) = split(/:/, $wh, 2); + push @$watch_hdrs, [ $k, qr/\Q$v\E/ ]; + } + if (my $list_ids = $ibx->{listid}) { + for (@$list_ids) { + my $re = qr/<[ \t]*\Q$_\E[ \t]*>/; + push @$watch_hdrs, ['List-Id', $re ]; + } + } + if (scalar @$watch_hdrs) { + $ibx->{-watchheaders} = $watch_hdrs; } my $new = "$watch/new"; my $cur = "$watch/cur"; - push @mdir, $new, $cur; - die "$new already in use\n" if $mdmap{$new}; - die "$cur already in use\n" if $mdmap{$cur}; - $mdmap{$new} = $mdmap{$cur} = $inbox; + push @mdir, $new unless $uniq{$new}++; + push @mdir, $cur unless $uniq{$cur}++; + + push @{$mdmap{$new} ||= []}, $ibx; + push @{$mdmap{$cur} ||= []}, $ibx; } else { warn "watch unsupported: $k=$watch\n"; } - } + }); return unless @mdir; my $mdre = join('|', map { quotemeta($_) } @mdir); @@ -76,121 +93,170 @@ sub new { 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 $importers = $self->{importers}; + foreach my $im (values %$importers) { + $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 =~ /:2,[A-R]*S[T-Z]*\z/i or return; + # 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); - foreach my $inbox (values %{$self->{mdmap}}) { - next unless ref $inbox; - my $im = _importer_for($self, $inbox); - $im->remove($mime); - if (my $scrub = _scrubber_for($inbox)) { - my $scrubbed = $scrub->scrub($mime) or next; - $im->remove($scrubbed); + $self->{config}->each_inbox(sub { + my ($ibx) = @_; + eval { + my $im = _importer_for($self, $ibx); + $im->remove($mime, 'spam'); + if (my $scrub = $ibx->filter($im)) { + my $scrubbed = $scrub->scrub($mime, 1); + $scrubbed or return; + $scrubbed == REJECT() and return; + $im->remove($scrubbed, 'spam'); + } + }; + 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; + return unless PublicInbox::InboxWritable::is_maildir_path($path); if ($path !~ $self->{mdre}) { warn "unrecognized path: $path\n"; return; } - my $inbox = $self->{mdmap}->{$1}; - unless ($inbox) { + my $inboxes = $self->{mdmap}->{$1}; + unless ($inboxes) { warn "unmappable dir: $1\n"; return; } - if (!ref($inbox) && $inbox eq 'watchspam') { + if (!ref($inboxes) && $inboxes 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)) { - $mime = $scrub->scrub($mime) or return; - } - _force_mid($mime); - $im->add($mime, $self->{spamcheck}); + my $warn_cb = $SIG{__WARN__} || sub { print STDERR @_ }; + local $SIG{__WARN__} = sub { + $warn_cb->("path: $path\n"); + $warn_cb->(@_); + }; + foreach my $ibx (@$inboxes) { + my $mime = _path_to_mime($path) or next; + my $im = _importer_for($self, $ibx); + + # any header match means it's eligible for the inbox: + if (my $watch_hdrs = $ibx->{-watchheaders}) { + my $ok; + my $hdr = $mime->header_obj; + for my $wh (@$watch_hdrs) { + my $v = $hdr->header_raw($wh->[0]); + next unless defined($v) && $v =~ $wh->[1]; + $ok = 1; + last; + } + next unless $ok; + } + + if (my $scrub = $ibx->filter($im)) { + my $ret = $scrub->scrub($mime) or next; + $ret == REJECT() and next; + $mime = $ret; + } + $im->add($mime, $self->{spamcheck}); + } } +sub quit { trigger_scan($_[0], 'quit') } + sub watch { my ($self) = @_; - my $cb = sub { _try_fsn_paths($self, \@_) }; - my $mdir = $self->{mdir}; + 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 $watcher = Filesys::Notify::Simple->new($mdir); - $watcher->wait($cb) while (1); + 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 return; + 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) = @_; - my $mdir = $self->{mdir}; - foreach my $dir (@$mdir) { - my $ok = opendir(my $dh, $dir); - unless ($ok) { - warn "failed to open $dir: $!\n"; - next; - } + my ($self, $path) = @_; + if ($path =~ /quit\z/) { + %{$self->{opendirs}} = (); + _done_for_now($self); + delete $self->{scandir}; + $self->{quit} = 1; + return; + } + # else: $path =~ /(cont|full)\z/ + return if $self->{quit}; + 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; } - closedir $dh; } _done_for_now($self); + # do we have more work to do? + trigger_scan($self, 'cont') if keys %$opendirs; } sub _path_to_mime { @@ -199,7 +265,7 @@ sub _path_to_mime { local $/; my $str = <$fh>; $str or return; - return Email::MIME->new(\$str); + return PublicInbox::MIME->new(\$str); } elsif ($!{ENOENT}) { return; } else { @@ -209,28 +275,15 @@ sub _path_to_mime { } 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); - }; - $self->{importers}->{"$im"} = $im; -} - -sub _scrubber_for { - my ($inbox) = @_; - my $f = $inbox->{filter}; - if ($f && $f =~ /::/) { - eval "require $f"; - if ($@) { - warn $@; - } else { - return $f->new; - } + my ($self, $ibx) = @_; + my $importers = $self->{importers}; + my $im = $importers->{"$ibx"} ||= $ibx->importer(0); + if (scalar(keys(%$importers)) > 2) { + delete $importers->{"$ibx"}; + _done_for_now($self); } - undef; + + $importers->{"$ibx"} = $im; } sub _spamcheck_cb { @@ -239,11 +292,18 @@ sub _spamcheck_cb { my ($mime) = @_; my $tmp = ''; if ($sc->spamcheck($mime, \$tmp)) { - return Email::MIME->new(\$tmp); + return PublicInbox::MIME->new(\$tmp); } warn $mime->header('Message-ID')." failed spam check\n"; undef; } } +sub is_maildir { + $_[0] =~ s!\Amaildir:!! or return; + $_[0] =~ tr!/!/!s; + $_[0] =~ s!/\z!!; + $_[0]; +} + 1;