use Data::Dumper;
use Errno;
-use Fcntl qw(O_WRONLY O_EXCL O_CREAT);
+use Fcntl;
use FileHandle;
+use File::FcntlLock;
use File::Temp qw(tempfile);
use File::stat;
use Getopt::Long qw(:config gnu_getopt no_ignore_case);
-use POSIX qw(strftime WEXITSTATUS WIFEXITED);
+use POSIX qw(WIFEXITED WEXITSTATUS WIFSIGNALED WTERMSIG);
use Pod::Usage;
+use constant LOCK_TRIES => 60;
+
our $VERSION = 1;
# If a filter set's header is $MAGIC_TO_TOKEN, that set is compared
my $norun;
my $rebuild_dot_folders;
+if (!caller()) {
GetOptions(
'd' => \$dumpfilters,
'h|help' => \$help,
'r' => \$rebuild_dot_folders,
) or pod2usage();
$help and pod2usage(-exitstatus=>0, -verbose=>1);
-@ARGV == 0 or pod2usage();
+}
our $run = !$norun;
if (not $HOME) {
die("HOME environment variable must be set.\n");
}
-if (not $MAILDIR) {
- $MAILDIR = "$HOME/Maildir";
-}
=head1 FILES
B<minc> adds all folders it filters into to this file, which is used
by lukem's B<new(1)> (XXX need a link).
-=item `mhpath +`/logs/minc.log
-
-Where B<minc> logs what it does, unless in -n mode.
-
=item `mhpath +`/.minc.context
B<minc> uses this file for context (i.e. current folder) instead of
my $mh;
-$mh = `mhpath +`;
+$mh = `mhpath +`; $? >= 0 or die;
chomp($mh);
-
-my $logfile = $mh . '/logs/minc.log';
-
-$ENV{"MHCONTEXT"} = $mh . '/.minc.context';
-
-\f
-###############################################################################
-# Logging
-
-sub mylog {
- $run or return;
-
- my $timestamp = strftime('%b %e %H:%M:%S', localtime);
- my $msg;
- foreach my $part (@_) {
- if (defined($part)) {
- $msg .= $part;
- }
- }
- # no newlines in the log message, thanks
- $msg =~ s/\n/ /gm;
-
- open(LOG, ">>$logfile") or die("open(>>$logfile): $!");
- print(LOG "$timestamp $msg\n") or die("print(>>$logfile): $!");
- close(LOG) or die("close($logfile): $!");
-}
-
-sub logheader {
- my ($text, @contents) = @_;
- my $last;
-
- if (@contents) {
- $last = $contents[-1];
- } else {
- $last = '';
- }
-
- mylog('<< ', $text, $last);
+if (!$mh) {
+ die('mhpath did not give MH mail path: ' . exit_msg($?));
}
-sub log_headers {
- my %headers = %{(shift)};
+$ENV{"MHCONTEXT"} = $mh . '/.minc.context';
- # For an explanation of the %headers structure, see the
- # get_headers function below.
- logheader('From: ', @{$headers{'return-path'}});
- logheader('To: ', @{$headers{'to'}});
- logheader('Subject: ', @{$headers{'subject'}});
- logheader('Message-Id: ', @{$headers{'message-id'}});
+# TODO: Support dot-locking too. This works on FreeBSD and Linux.
+my $locking = `mhparam datalocking`;
+$? < 0 && die;
+$? == 0 || die('mhparam datalocking: ' . exit_msg($?));
+chomp($locking);
+if ($locking ne 'fcntl') {
+ die("mh locking $locking not supported; only fcntl");
}
\f
###############################################################################
# Utility procedures
+sub exit_msg {
+ my $status = shift;
+ WIFEXITED($status) && return 'exited with status ' . WEXITSTATUS($status);
+ WIFSIGNALED($status) && return 'killed with signal ' . WTERMSIG($status);
+ # WTF
+ "died ($status)";
+}
+
sub sort_by_list {
my $a = shift;
my $b = shift;
my $folder = shift;
my $msgnum = shift;
my $seq = shift;
+
my $fn = "$mh/$folder/.mh_sequences";
- my $fh;
- my @sequences;
+ my ($fh, $e) = lkopen_fcntl($fn, O_RDWR | O_CREAT, 0600);
- if (not open($fh, $fn)) {
- $!{ENOENT} or die("open($fn): $!");
- } else {
- @sequences = <$fh>;
- chomp(@sequences);
- }
+ my @sequences = <$fh>;
+ chomp(@sequences);
+
+ seek($fh, 0, SEEK_SET) or die("seek($fn): $!");
+ truncate($fh, 0) or die("truncate($fn): $!");
my $marked = 0;
- open($fh, '>', $fn) or die("open(>$fn): $!");
for $_ (@sequences) {
if (/^$seq: (.*)/) {
my @parts;
close($fh) or die("close(>$fn): $!");
}
+# Based on nmh's lkopen_fcntl
+# Return 0 for success, errno on failure.
+sub lkopen_fcntl {
+ my $fn = shift;
+ my $access = shift;
+ my $mode = shift;
+ my $errno;
+
+ # The assumption here is that if you open the file for writing, you
+ # need an exclusive lock.
+
+ my $tries = LOCK_TRIES;
+ for (;;) {
+ sysopen(my $fh, $fn, $access, $mode) or die("sysopen($fn): $!");
+
+ my $flk = File::FcntlLock->new;
+ $flk->l_start(0);
+ $flk->l_len(0);
+ $flk->l_type(($access & O_ACCMODE) == O_RDONLY ? F_RDLCK : F_WRLCK);
+ $flk->l_whence(SEEK_SET);
+
+ # Really should only retry on EAGAIN and EINTR...
+ if ($flk->lock($fh, F_SETLK)) {
+ return $fh;
+ }
+
+ $errno = $flk->lock_errno;
+ close($fh) or die("close($fn): $!");
+
+ if (--$tries == 0) {
+ last;
+ }
+ sleep(1);
+ }
+
+ local $! = $errno;
+ die("failed to lock $fn: $!");
+}
+
+my @filtered;
sub store_message {
- my $msg = shift;
+ my $inbox = shift;
+ my $msg = shift; # rename $src_msg
my $mhfolder = shift;
- my $msgnum;
+ my ($msgnum, $mhmsg); # rename $dst_msg and $dst_msgpath
my $try;
- my $mhmsg;
# We must do this even in -n mode because later steps fail without
# it. This should be harmless.
mkfolder($mhfolder);
+ if ("+$mhfolder" eq $inbox) {
+ # If @filtered is empty, this message already has the right number.
+ if (!($msgnum = shift(@filtered))) {
+ $msg =~ m|.*/(\d+)$|;
+ return $1;
+ }
+ $mhmsg = "$mh/$mhfolder/$msgnum";
+ } else {
# This loop is a modified version of the maildir delivery algorithm.
$msgnum = get_highest_msgnum($mhfolder);
for ($try = 0; ; $try++) {
#sleep(2);
}
- mylog('+', $mhfolder);
+ if ($run) {
+ # Mark each message as soon as we store it and bomb if that
+ # fails. While it is slow, it is not safe to store multiple
+ # messages and then have a failure before marking some (or
+ # all).
+ if ($mhfolder ne 'SPAM') {
+ mark($mhfolder, $msgnum, 'unseen');
+ }
+ }
+ }
+ push(@filtered, $msg);
if ($run) {
if (not rename($msg, $mhmsg)) {
die("rename($msg, $mhmsg): $!");
}
-
- # Mark each message as soon as we store it and bomb if that
- # fails. While it is slow, it is not safe to store multiple
- # messages and then have a failure before marking some (or
- # all).
- if ($mhfolder ne 'SPAM') {
- mark($mhfolder, $msgnum, 'unseen');
- }
}
return $msgnum;
sub find_mh_folder {
my $msg = shift;
- my %headers = %{(shift)};
- my $filterref;
- my @filter;
- my $header;
- my $contents;
- my $pair;
- my $regexp;
- my $expression;
- my $result;
-
- if (not %headers) {
+ my $header = shift;
+
+ if (not %$header) {
return 'malformed';
}
# Walk the list of filters. This structure is documented in
# pod at the end of the program.
- foreach $filterref (@FILTERS) {
- @filter = @$filterref;
- $header = shift(@filter);
-
- # Handle filters using the magic TO header specially.
- if ($header eq $MAGIC_TO_TOKEN) {
- foreach $header (keys(%headers)) {
- if ($header =~ /$MAGIC_TO_REGEX/i) {
- foreach $contents (@{$headers{lc($header)}}) {
- foreach $pair (@filter) {
- ($regexp, $expression) = @$pair;
- if ($contents =~ $regexp) {
- if (eval "\$result = \"$expression\"") {
- return $result;
- }
- }
- }
- }
- }
- }
-
- # Now that it's been processed specially, skip normal handling.
+ for my $filterref (@FILTERS) {
+ if (ref($filterref) eq 'CODE') {
+ my $m = $filterref->($header, $msg);
+ $m && return $m;
next;
}
- # Walk the list of message headers matching the filter's
- # specified header.
- foreach $contents (@{$headers{lc($header)}}) {
- # Walk the filter's list of regexp/expression pairs.
- foreach $pair (@filter) {
- ($regexp, $expression) = @$pair;
- if ($contents =~ $regexp) {
- if (eval "\$result = \"$expression\"") {
- return $result;
- }
- }
+ my $m = match($header, @$filterref);
+ $m && return $m;
+ }
+
+ return 'inbox';
+}
+
+# Test all the header fields against each [regexp, folder-expression] pair.
+sub match {
+ my $header = shift;
+ my $filter_field = shift;
+ my @filters = @_;
+
+ # Handle filters using the magic TO header specially.
+ if ($filter_field eq $MAGIC_TO_TOKEN) {
+ for my $field_name (keys(%$header)) {
+ if ($field_name =~ /$MAGIC_TO_REGEX/i) {
+ my $m = match_one_field($header->{$field_name}, \@filters);
+ $m && return $m;
}
}
+ # Now that it's been processed specially, skip normal handling.
+ return;
}
- return 'inbox';
+ # Walk the list of header fields matching the filter's specified header.
+ my $m = match_one_field($header->{lc($filter_field)}, \@filters);
+ $m && return $m;
+}
+
+# Test all the values of one header field against each [regexp,
+# folder-expression] pair.
+sub match_one_field {
+ my $values = shift;
+ my $filters = shift;
+ for my $value (@$values) {
+ for my $pair (@$filters) {
+ my ($regexp, $expression) = @$pair;
+ if ($value =~ $regexp) {
+ my $result;
+ if (eval "\$result = \"$expression\"") {
+ return $result;
+ }
+ }
+ }
+ }
}
sub scan_line {
}
sub filter_mail {
+ my $inbox = shift;
@_ or return ();
my $msgcount = @_ - 2; # don't count . and ..
my $len = length($msgcount);
my $msgnum;
my %folders;
- if (-f "$HOME/.minc") {
- require "$HOME/.minc";
- }
-
# XXX lame names
my $nf = int($COLUMNS * $SCAN_P_FOLDER);
my $nm = int($COLUMNS * $SCAN_P_MESSAGE);
($msg eq '.' or $msg eq '..') and next;
my $headers = get_headers($msg);
- log_headers($headers);
undef($mhfolder);
for my $hook (@filter_hooks) {
defined($mhfolder) or ($mhfolder = find_mh_folder($msg, $headers));
- $msgnum = store_message($msg, $mhfolder);
+ $msgnum = store_message($inbox, $msg, $mhfolder);
$folders{$mhfolder}++;
if ($tty) {
}
\f
-MAIN: {
+if (!caller()) {
my $st;
if ($dumpfilters) {
$rebuild_dot_folders and exit(create_dot_folders);
- chdir("$MAILDIR/new") or die("chdir($MAILDIR/new): $!");
- my %folders = filter_mail(map { $_->[1] }
+ if (-f "$HOME/.minc") {
+ require "$HOME/.minc";
+ }
+
+ my $inbox;
+ if ($MAILDIR) {
+ $inbox = $MAILDIR;
+ } elsif (-d "$HOME/Maildir") {
+ $inbox = "$HOME/Maildir";
+ }
+
+ if (@ARGV > 0) {
+ $inbox = shift(@ARGV);
+ }
+
+ my @files;
+ if (substr($inbox, 0, 1) eq '+') {
+ my @msgs = @ARGV;
+ if (!@msgs) {
+ @msgs = ('cur-last');
+ }
+ open(my $fh, '-|', 'mhpath', @msgs) or die("open(mhpath|): $!");
+ chomp(@files = <$fh>);
+ if (!close($fh)) {
+ $! == 0 or die("open(mhpath|): $!");
+ die('mhpath '. exit_msg($?));
+ }
+ @files > 0 or exit 0;
+ } else {
+ @ARGV == 0 or pod2usage();
+ chdir("$inbox/new") or die("chdir($inbox/new): $!");
+ @files = map { $_->[1] }
+ sort { $a->[0] <=> $b->[0] }
+ map {
+ $st = stat($_) or die("stat($_): $!");
+ [ $st->mtime, $_ ]
+ } getfiles('.');
+
+ @files = map { $_->[1] }
sort { $a->[0] <=> $b->[0] }
map {
if (not ($st = stat($_))) {
}
[$st->mtime, $_]
}
- getfiles('.'));
+ getfiles('.');
+ }
+
+ my %folders = filter_mail($inbox, @files);
$run and %folders and update_dot_folders(\%folders);
scan_spam();
}
+1;
+
\f
__END__
projects / minc / blobdiff