lib/PublicInbox/WatchMaildir.pm

   1 # Copyright (C) 2016 all contributors <meta@public-inbox.org>
   2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   3 package PublicInbox::WatchMaildir;
   4 use strict;
   5 use warnings;
   6 use Email::MIME;
   7 use Email::MIME::ContentType;
   8 $Email::MIME::ContentType::STRICT_PARAMS = 0; # user input is imperfect
   9 use PublicInbox::Git;
  10 use PublicInbox::Import;
  11 use PublicInbox::MDA;
  12
  13 sub new {
  14         my ($class, $config) = @_;
  15         my (%mdmap, @mdir);
  16         foreach my $k (keys %$config) {
  17                 $k =~ /\Apublicinbox\.([^\.]+)\.watch\z/ or next;
  18                 my $name = $1;
  19                 my $watch = $config->{$k};
  20                 if ($watch =~ s/\Amaildir://) {
  21                         $watch =~ s!/+\z!!;
  22                         my $inbox = $config->lookup_name($name);
  23                         if (my $wm = $inbox->{watchheader}) {
  24                                 my ($k, $v) = split(/:/, $wm, 2);
  25                                 $inbox->{-watchheader} = [ $k, qr/\Q$v\E/ ];
  26                         }
  27                         my $new = "$watch/new";
  28                         my $cur = "$watch/cur";
  29                         push @mdir, $new, $cur;
  30                         $mdmap{$new} = $inbox;
  31                         $mdmap{$cur} = $inbox;
  32                 } else {
  33                         warn "watch unsupported: $k=$watch\n";
  34                 }
  35         }
  36         return unless @mdir;
  37
  38         my $mdre = join('|', map { quotemeta($_) } @mdir);
  39         $mdre = qr!\A($mdre)/!;
  40         bless {
  41                 mdmap => \%mdmap,
  42                 mdir => \@mdir,
  43                 mdre => $mdre,
  44                 importers => {},
  45         }, $class;
  46 }
  47
  48 sub _try_fsn_paths {
  49         my ($self, $paths) = @_;
  50         _try_path($self, $_->{path}) foreach @$paths;
  51         $_->done foreach values %{$self->{importers}};
  52 }
  53
  54 sub _try_path {
  55         my ($self, $path) = @_;
  56         if ($path !~ $self->{mdre}) {
  57                 warn "unrecognized path: $path\n";
  58                 return;
  59         }
  60         my $inbox = $self->{mdmap}->{$1};
  61         unless ($inbox) {
  62                 warn "unmappable dir: $1\n";
  63                 return;
  64         }
  65         my $im = $inbox->{-import} ||= eval {
  66                 my $git = $inbox->git;
  67                 my $name = $inbox->{name};
  68                 my $addr = $inbox->{-primary_address};
  69                 PublicInbox::Import->new($git, $name, $addr);
  70         };
  71         $self->{importers}->{"$im"} = $im;
  72         my $mime;
  73         if (open my $fh, '<', $path) {
  74                 local $/;
  75                 my $str = <$fh>;
  76                 $str or return;
  77                 $mime = Email::MIME->new(\$str);
  78         } elsif ($!{ENOENT}) {
  79                 return;
  80         } else {
  81                 warn "failed to open $path: $!\n";
  82                 return;
  83         }
  84
  85         $mime->header_set($_) foreach @PublicInbox::MDA::BAD_HEADERS;
  86         my $wm = $inbox->{-watchheader};
  87         if ($wm) {
  88                 my $v = $mime->header_obj->header_raw($wm->[0]);
  89                 return unless ($v && $v =~ $wm->[1]);
  90         }
  91         my $f = $inbox->{filter};
  92         if ($f && $f =~ /::/) {
  93                 eval "require $f";
  94                 if ($@) {
  95                         warn $@;
  96                 } else {
  97                         $f = $f->new;
  98                         $mime = $f->scrub($mime);
  99                 }
 100         }
 101         $mime or return;
 102         my $mid = $mime->header_obj->header_raw('Message-Id');
 103         $im->add($mime);
 104 }
 105
 106 sub watch {
 107         my ($self) = @_;
 108         my $cb = sub { _try_fsn_paths($self, \@_) };
 109         my $mdir = $self->{mdir};
 110
 111         require Filesys::Notify::Simple;
 112         my $watcher = Filesys::Notify::Simple->new($mdir);
 113         $watcher->wait($cb) while (1);
 114 }
 115
 116 sub scan {
 117         my ($self) = @_;
 118         my $mdir = $self->{mdir};
 119         foreach my $dir (@$mdir) {
 120                 my $ok = opendir(my $dh, $dir);
 121                 unless ($ok) {
 122                         warn "failed to open $dir: $!\n";
 123                         next;
 124                 }
 125                 while (my $fn = readdir($dh)) {
 126                         next unless $fn =~ /\A[a-zA-Z0-9][\w:,=\.]+\z/;
 127                         $fn = "$dir/$fn";
 128                         if (-f $fn) {
 129                                 _try_path($self, $fn);
 130                         } else {
 131                                 warn "not a file: $fn\n";
 132                         }
 133                 }
 134                 closedir $dh;
 135         }
 136 }
 137
 138 1;