/usr/share/perl5/Mail/CrossAssassin.pm is in debbugs 2.6.0.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 | # CrossAssassin.pm 2004/04/12 blarson
package Mail::CrossAssassin;
use strict;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(ca_init ca_keys ca_set ca_score ca_expire);
our $VERSION = 0.1;
use Digest::MD5 qw(md5_base64);
use DB_File;
our %database;
our $init;
our $addrpat = '\b\d{3,8}(?:-(?:close|done|forwarded|maintonly|submitter|quiet))?\@bugs\.debian\.org';
sub ca_init(;$$) {
my $ap = shift;
$addrpat = $ap if(defined $ap);
my $dir = shift;
return if ($init && ! defined($dir));
$dir = "$ENV{'HOME'}/.crosssassassin" unless (defined($dir));
(mkdir $dir or die "Could not create \"$dir\"") unless (-d $dir);
untie %database;
tie %database, 'DB_File', "$dir/Crossdb"
or die "Could not initialize crosassasin database \"$dir/Crossdb\": $!";
$init = 1;
}
sub ca_keys($) {
my $body = shift;
my @keys;
my $m = join('',@$body);
$m =~ s/\n(?:\s*\n)+/\n/gm;
if (length($m) > 4000) {
my $m2 = $m;
$m2 =~ s/\S\S+/\*/gs;
push @keys, '0'.md5_base64($m2);
}
# $m =~ s/^--.*$/--/m;
$m =~ s/$addrpat/LOCAL\@ADDRESS/iogm;
push @keys, '1'.md5_base64($m);
return join(' ',@keys);
}
sub ca_set($) {
my @keys = split(' ', $_[0]);
my $now = time;
my $score = 0;
my @scores;
foreach my $k (@keys) {
my ($count,$date) = split(' ',$database{$k});
$count++;
$score = $count if ($count > $score);
$database{$k} = "$count $now";
push @scores, $count;
}
return (wantarray ? @scores : $score);
}
sub ca_score($) {
my @keys = split(' ', $_[0]);
my $score = 0;
my @scores;
my $i = 0;
foreach my $k (@keys) {
my ($count,$date) = split(' ',$database{$k});
$score = $count if ($count > $score);
$i++;
push @scores, $count;
}
return (wantarray ? @scores : $score);
}
sub ca_expire($) {
my $when = shift;
my @ret;
my $num = 0;
my $exp = 0;
while (my ($k, $v) = each %database) {
$num++;
my ($count, $date) = split(' ', $v);
if ($date <= $when) {
delete $database{$k};
$exp++;
}
}
return ($num, $exp);
}
END {
return unless($init);
untie %database;
undef($init);
}
1;
|