Re: Sieve eller annat
Jonas Jacobsson <jonas@cytech.nu> writes:
> Hej.
>
> Jag kör cyrus-imapd 1.5.19 (debian testing) och skulle vilja
> ha tips på något program liknande sieve som kan hjälpa mig
> sortera mail på server side. Sieve ingår inte i cyrus-imapd
> förrän i v2.x om jag förstått saken rätt.
>
> Tips?
>
> Provade intstallera mailutils som ska innehålla sieve,
> men den verkar bara fixa mbox-formatet?
>
> Från
> http://www.gnu.org/software/mailutils/manual/html_chapter/mailutils_6.html#SEC144
>
> `-f'
> `--mbox-url=mbox'
> Mailbox to sieve (defaults to user's system mailbox)
>
> /jonas, ledsen amatör
>
>
Det här är lite work-in-progress f.n., men den fungerar i alla
fall hyfsat. Kör från cron några gånger per timma. (Kanske inte
värdens bästa perl, någon som vet hur man "inkluderar" en bit
programkod från annan fil utan att använda pathen?)
#!/usr/bin/perl
#
# $Id: strul_sortmail,v 1.6 2003/06/01 15:33:35 tobbe Exp tobbe $
# $Source: /home/tobbe/Private/strul/s/strul_sortmail,v $
#
# $Log: strul_sortmail,v $
# Revision 1.6 2003/06/01 15:33:35 tobbe
# Debug stuff added.
#
# Revision 1.5 2003/05/26 11:15:40 tobbe
# Bugfix.
#
# Revision 1.4 2003/05/26 11:14:35 tobbe
# Support for zephyr notifcation.
#
# Revision 1.3 2003/05/24 07:48:34 tobbe
# Removed stupid output.
#
# Revision 1.2 2003/05/24 07:03:55 tobbe
# Works, but for minor issues.
# -) Regexps seems to be case sensitive.
# -) Slow.
#
# Revision 1.1 2003/05/22 09:40:04 tobbe
# Initial revision
#
#
#
################################################################
$version = '$Revision: 1.6 $';
$progname = 'strul_sortmail';
$never_true = 0;
################################################################
#
# Load some libraries:
#
use IO::Socket::INET;
use Mail::IMAPClient;
use Getopt::Std;
################################################################
#
# Administrative sub routines
#
################################################################
################################################################
#
#
sub adm_mess {
print "\n";
print "\n** $progname $version: $_[0]\n";
}
################################################################
#
#
sub adm_err {
adm_mess $_[0];
die "** exit\n\n";
}
################################################################
#
# Program specific sub routines
#
################################################################
################################################################
#
#
sub parse_args {
$usage="$progname -v";
getopts('vd') || die "Error: usage: $usage";
if ($opt_v) { $verbose=1; };
if ($opt_d) { $debug=1; };
return 0;
}
################################################################
#
# Write message to stdout, adding information about program
# name and revision level.
#
sub adm_debug {
if( $debug ) {
print "\n** strul_sortmail: $_[0]\n";
};
}
################################################################
#
# Write message to stdout, adding information about program
# name and revision level.
#
sub adm_verbose {
if( $verbose ) {
print "\n** strul_sortmail: $_[0]\n";
};
}
################################################################
#
# Put this in separate part!!!
$invdir=substr( $0, 0, rindex( $0, $dirsep ));
push( @INC, $invdir);
push( @INC, "/home/tobbe/Private/share/etc/src");
require("procmailsrc");
#
#
################################################################
$YEAR=2003;
################################################################
################################################################
#
# Do the right thing
#
# Parse command line arguments
parse_args();
my $s = IO::Socket::INET->new( PeerAddr => 'replace-with-name-of-mailserver',
PeerPort => 'imap',
Proto => 'tcp' );
die $@ unless defined $s;
my $imap = Mail::IMAPClient->new( User=> 'tobbe', Socket=>$s,
Password => 'PASSWORD_HERE' );
$imap->Uid( 0 );
#$imap->Debug( 1 );
$imap->State( $imap->Connected());
$imap->login or die $@;
$imap->select('Inbox') or die $@;
$cnt=1;
$nummess = $imap->message_count( );
#print "parsing ",$nummess , " messages";
@sortedmatches= reverse @matches;
while( $cnt <= $nummess ) {
$from="";
$move=0;
$destfolder = "";
@matchstrings=@sortedmatches;
$headers = $imap->parse_headers( $cnt, 'ALL' );
while( defined( $match = pop( @matchstrings ))) {
$mr=lc( $match->{regexp});
$mf=lc( $match->{folder});
$mh=lc( "\^".$match->{header}."\$");
if( defined( $match->{zephyr} )) {
$zephyr= $match->{zephyr};
} else {
$zephyr = '';
};
$from = $headers->{From}->[0];
$from =~ s/[><]//g;
$from =~ s/@.*$//g;
while(( $left,$right) = each %{$headers} ) {
$l = lc( $left );
$r = lc( $right->[0] );
$l =~ $mh && ( adm_debug("$cnt :$l:$mh: - :$r:$mr" ));
$l =~ $mh && $r =~ $mr && ( $move=1, $destfolder= $mf, last );
};
if( $move ) {
last;
};
};
if( $move ) {
adm_debug( "Move:$move:destfolder:$destfolder:" );
};
if( $move && $destfolder eq '' ) {
adm_debug( "no dest folder!" );
};
if( $move && $destfolder ne '' ) {
adm_debug( "moving:");
$destfolder =~ s/\$year/$YEAR/g;
$destfolder =~ s/\//./g;
$destfolder = "Inbox.$destfolder";
if( ! defined $imap->move( $destfolder, $cnt )) {
print "destination folder :$destfolder:\n";
die $imap->LastError;
};
if( $zephyr ne '' ) {
`zwrite -d -q tobbe -m Mail on Friday from: $from`;
};
};
$cnt++;
};
$imap->close();
$imap->logout;
################################################################
#
# End
#
#123456789|xxxxxxxxx|xxxxxxxxx|xxxxxxxxx|xxxxxxxxx|xxxxxxxxx|
#
# Local Variables:
# mode: perl
# End:
################################################################
Och en nerkortad version av regelfilen. (mitt orginal har över
300 regler..)
# $Id: procmailsrc,v 1.5 2003/06/25 08:15:25 anoncvs Exp $
# $Source: /usr/local/cvsroot/Private/share/etc/src/procmailsrc,v $
#
# $Log: procmailsrc,v $
# Revision 1.5 2003/06/25 08:15:25 anoncvs
# Spam is spam, whoever it comes from... :-(
#
# Revision 1.4 2003/05/26 11:14:16 anoncvs
# Support for zephyr notification.
#
# Revision 1.3 2003/05/26 11:06:17 anoncvs
# We are not getting the inital whitespace in headers since we
# receive headers explicitely.
#
# Revision 1.2 2003/05/26 08:19:05 anoncvs
# Bugfix.
#
# Revision 1.1 2003/05/23 14:32:40 anoncvs
# Imported procmailrc.
#
#
#
################################################################
@matches = (
{
header => 'X-Spam-Flag',
regexp => 'YES',
folder => 'SPAM',
},
{
header => '(Cc|Newsgroups|To|Resent-To|X-Mailing-List|From)',
regexp => '.*debian-user-swedish@lists\.debian\.org',
folder => '$YEAR/list_debian-user-swedish',
},
{
header => '(Cc|Newsgroups|To|Resent-To|X-Mailing-List|From)',
regexp => '.*debian-devel@lists\.debian\.org',
folder => '$YEAR/list_debian-devel',
},
{
header => '(Cc|Newsgroups|To|Resent-To|X-Mailing-List|From)',
regexp => '.*debian-mirrors@lists\.debian\.org',
folder => '$YEAR/list_debian-mirrors',
},
{
header => '(Cc|Newsgroups|To|Resent-To|X-Mailing-List|From)',
regexp => '.*@(.*\.)?debian\.org',
folder => '$YEAR/list_debian',
},
#
# Subject
#
{
header => 'Subject',
regexp => 'Security\:.*|SECURITY information|system check',
folder => '$YEAR/logs_security',
},
#
# Kill-file part
#
# SPAM!!!!
{
header => 'From',
regexp => '.*@(idg\.se|sponsringsforeningen\.com)',
folder => 'SPAM',
},
{
header => '(From|To|Cc)',
regexp => '.*<?info@everyday\.com',
folder => 'SPAM',
},
{
header => 'From',
regexp => '.*@strul\.nu',
folder => '$YEAR/tobbe',
zephyr => 'Tobbe',
},
{
header => 'To',
regexp => 'postmaster',
folder => '$YEAR/postmaster',
},
{
header => 'Content-Type',
regexp => 'html',
folder => 'SPAM',
},
);
Reply to: