]> diplodocus.org Git - minc/blobdiff - minc
(find_mh_folder): Down-case header from %FILTERS before trying to
[minc] / minc
diff --git a/minc b/minc
index e4e6ce7c365fc1617a57134dd5c5cea26ee653d9..2f649e7030098e71f60e0c9dfc721e5cbea53205 100755 (executable)
--- a/minc
+++ b/minc
@@ -8,7 +8,7 @@ B<minc> - Incorporate mail from a maildir into mh folders.
 
 =head1 SYNOPSIS
 
-B<minc> [-B<dhn>]
+B<minc> [-B<dhns>]
 
 =head1 DESCRIPTION
 
@@ -65,18 +65,28 @@ Show help.
 Dry run; do not actually incorporate the mail, but log and report to
 stdout/stderr as normal.
 
+=item B<-s>
+
+Process SPAM only, then exit, leaving all non-spam messages in the
+maildir.
+
 =back
 
 =cut
 
 my $dumpfilters = 0;
 my $run = 1;
+my $spamonly = 0;
+
 our $opt_d;
 our $opt_h;
 our $opt_n;
-if (!getopts('dhn')) {
+our $opt_s;                     # ;; # stupid cperl-mode
+
+if (!getopts('dhns')) {
     exit(&EX_USAGE);
 }
+
 if ($opt_d) {
     $dumpfilters = 1;
 } elsif ($opt_h) {
@@ -86,6 +96,10 @@ if ($opt_d) {
     $run = 0;
 }
 
+if ($opt_s) {                   # ))){ # stupid cperl-mode
+    $spamonly = 1;
+}
+
 =head1 ENVIRONMENT
 
 =over 4
@@ -187,16 +201,45 @@ sub logerr { mylog('error', ERRORCHAR, @_); }
 sub log_headers {
     my %headers = @_;
 
-    logincoming('From:       ', $headers{'Return-Path'});
-    logincoming('To:         ', $headers{'To'});
-    logincoming('Subject:    ', $headers{'Subject'});
-    logincoming('Message-Id: ', $headers{'Message-Id'});
+    logincoming('From:       ', $headers{'return-path'});
+    logincoming('To:         ', $headers{'to'});
+    logincoming('Subject:    ', $headers{'subject'});
+    logincoming('Message-Id: ', $headers{'message-id'});
 }
 
 \f
 ###############################################################################
 # Utility procedures
 
+sub _errprint {
+    printf("%s:%s", __FILE__, __LINE__);
+
+    if (@_) {
+        print(': ');
+        foreach (@_) {
+            print;
+        }
+    }
+}
+
+sub err {
+    my $ex = shift;
+
+    _errprint(@_);
+    print(": $!\n");
+
+    exit($ex);
+}
+
+sub errx {
+    my $ex = shift;
+
+    _errprint(@_);
+    print("\n");
+
+    exit($ex);
+}
+
 sub mkfolder {
     my $mhfolder = shift;
     my $folder;
@@ -213,7 +256,8 @@ sub mkfolder {
                 if (-d $target or mkdir($target)) {
                     next;
                 } else {
-                    die("Failed to create +$mhfolder ($component): $!\n");
+                    err(&EX_TEMPFAIL,
+                        "Failed to create +$mhfolder ($component)");
                 }
             }
         }
@@ -242,7 +286,7 @@ sub store_message {
 
     if ($run) {
         if (not rename($msg, $mhmsg)) {
-            die("Rename failed: $!\n");
+            err(&EX_TEMPFAIL, "Failed rename($msg, $mhmsg)");
         }
 
         if ($mhfolder ne 'SPAM') {
@@ -259,7 +303,8 @@ sub store_message {
 sub get_headers {
     my $msg = shift;
     my %headers;
-    my $current;            # current header, used for unfolding lines
+    my $current;                # current header, used for unfolding lines
+    my $fieldname;              # unmolested header name
 
     open(MSG, $msg);
     while (<MSG>) {
@@ -272,19 +317,15 @@ sub get_headers {
             # folded header continuation
 
             if (!defined($current)) {
-                # XXX: Malformed message; log to stderr
-                return undef;
+                print("Malformed message, cannot parse headers.\n");
+                return ();
             }
 
             $headers{$current} .= $_;
         } else {
-            ($current) = split(/:/);
-
-            # XXX: Is it correct simply to eat all whitespace between
-            # the colon and the first text for the header?
-            # Furthermore, is any space at all required?  Or is
-            # '^Subject:hey$' a perfectly valid header?
-            (undef, $headers{$current}) = split(/^$current:\s*/);
+            ($fieldname) = split(/:/);
+            $current = lc($fieldname);
+            (undef, $headers{$current}) = split(/^$fieldname:\s*/);
         }
     }
     close(MSG);
@@ -319,7 +360,7 @@ sub is_spam {
         logerr("$err: $message: $!");
 
         if (unlink($err) != 1) {
-            die("Failed unlink($err): $!\n");
+            err(&EX_TEMPFAIL, "Failed unlink($err)");
         }
     } elsif (-f $sig) {
         # This is supposed to be a signature created with razor-check
@@ -329,12 +370,11 @@ sub is_spam {
         # find and proceed with full razor-check mode.
 
         if (unlink($sig) != 1) {
-            die("Failed unlink($sig): $!\n");
+            err(&EX_TEMPFAIL, "Failed unlink($sig)");
         }
     }
 
-    #$status = system("razor-check < $msg");
-    $status = system('false');
+    $status = system("razor-check < $msg");
     if (WIFEXITED($status) and WEXITSTATUS($status) == 0) {
         return 1;
     } else {
@@ -346,16 +386,22 @@ sub kill_spam {
     my @msglist = @_;
     my @result;
     my $msg;
+    my $i;
 
     @result = ();
 
+    $i = 0;
     foreach $msg (@msglist) {
+        printf('%sChecking for spam... %6d/%d',
+               "\r", ++$i, scalar(@msglist));
         if (is_spam($msg)) {
+            print(" SPAM\n");
             store_message($msg, 'SPAM');
         } else {
             push(@result, $msg);
         }
     }
+    print("\nDone: ", scalar(@result), "\n");
 
     return @result;
 }
@@ -374,10 +420,14 @@ sub find_mh_folder {
     my $try;
 
     %headers = get_headers($msg);
+    if (not %headers) {
+        return 'inbox';
+    }
 
     log_headers(%headers);
 
     foreach $header (keys(%FILTERS)) {
+        $header = lc($header);
         $contents = $headers{$header};
 
         if (defined($contents)) {
@@ -418,7 +468,10 @@ MAIN: {
     }
 
     @msglist = kill_spam(glob("$MAILDIR/new/*"));
-    filter_mail(@msglist);
+
+    if (not $spamonly) {
+        filter_mail(@msglist);
+    }
 }
 
 __END__