wcm-0/0040755000203200000620000000000007761177273011222 5ustar wavexxstaffwcm-0/README0100644000203200000620000000174007761177021012070 0ustar wavexxstaffWorm Counter Measures ===================== Worm Counter Measures Copyright(c) wave++ "Yuri D'Elia" Distributed under GNU LGPL v2 or above WITHOUT ANY WARRANTY Creare un db ------------ db_load -t btree /var/lib/wcm < /dev/null Configurazione MTA (exim) ------------------------- acl_check_rcpt: # check whitelist ... # check blacklist ... defer hosts = !+relay_from_hosts condition = ${run {/usr/local/lib/wcm /var/lib/wcm $sender_host_address $sender_helo_name $sender_address $rcpt_count}{1}{0}} verify = recipient # accept ... (I dati sender_helo_name ed rcpt_count sono attualmente usati solo per le statistiche: e' possibile impostarli entrambi a 0). Expiry periodico ---------------- wcm-expunge /var/lib/wcm Compattazione db (a queue fermo, mensilmente) --------------------------------------------- db_dump /var/lib/wcm > /tmp/wcm rm /var/lib/wcm db_load -t btree /var/lib/wcm < /tmp/wcm rm /tmp/wcm wcm-0/wcm-expunge0100755000203200000620000000465107761177026013406 0ustar wavexxstaff#!/usr/bin/env perl # Worm Counter Measures # Copyright(c) wave++ "Yuri D'Elia" # Distributed under GNU LGPL v2 or above WITHOUT ANY WARRANTY use strict; use warnings; # Modules use File::Basename; use DB_File; ## ## Implementation ## # Data storage, current data format: # firstSeen (4 bytes int timestamp) # firstHelo (64 bytes string) # lastSeen (4 bytes int timestamp) # lastHelo (64 bytes string) # retries (4 bytes int) { package Data; my $PACK_FORMAT = "IZ64IZ64I"; sub new(%) { my %data = @_; my $self = {firstSeen => $data{firstSeen}, firstHelo => $data{firstHelo}, lastSeen => $data{lastSeen}, lastHelo => $data{lastHelo}, retries => $data{retries}}; bless $self; } sub unpack($) { my $data = shift; my ($firstSeen, $firstHelo, $lastSeen, $lastHelo, $retries) = unpack $PACK_FORMAT, $data; my $self = {firstSeen => $firstSeen, firstHelo => $firstHelo, lastSeen => $lastSeen, lastHelo => $lastHelo, retries => $retries}; bless $self; } } # returns true if a record needs to be expunged sub expunge($) { my ($data) = @_; my $now = time; my $totDays = ($now - $data->{firstSeen}) / 86400; my $elDays = ($now - $data->{lastSeen}) / 86400; my $period = ($data->{lastSeen} - $data->{firstSeen}) / 86400; my $rate = $period / $data->{retries}; # return true if the host is to be expunged return (($totDays > 7 && ($period < 1 || $data->{retries} < 2)) || ($elDays > 7 && $rate > 5) || ($elDays > 30)); } # open the database and attach the needed filters # (file) -> tied hash-ref sub openDb($) { # open the db handler my $file = shift; my $ref = tie my %db, "DB_File", $file, (O_RDWR | O_CREAT), 0666, $DB_BTREE; return undef if(!defined $ref); # attach read filters $ref->filter_fetch_key(sub {$_ = unpack("I", $_)}); $ref->filter_store_key(sub {$_ = pack ("I", $_)}); $ref->filter_fetch_value(sub {$_ = Data::unpack $_}); return \%db; } ## ## CLI ## # failure function my $prg = basename $0; sub failure($) { $_ = (join " ", @_); print STDERR "$prg: $_\n"; exit 1; } # process the parameters { my $prg = basename $0; my ($file) = @ARGV; failure "bad parameters" if(!$file || !-w $file); # open the db my $db = openDb $file; failure "unable to tie the db: $!" if(!defined $db); # process all identifiers while(my ($ip, $data) = each %$db) { delete $db->{$ip} if(expunge $data); } } wcm-0/wcm-lint0100755000203200000620000001011407761177026012670 0ustar wavexxstaff#!/usr/bin/env perl # Worm Counter Measures # Copyright(c) wave++ "Yuri D'Elia" # Distributed under GNU LGPL v2 or above WITHOUT ANY WARRANTY use strict; use warnings; # Modules use File::Basename; use DB_File; ## ## Implementation ## # Data storage, current data format: # firstSeen (4 bytes int timestamp) # firstHelo (64 bytes string) # lastSeen (4 bytes int timestamp) # lastHelo (64 bytes string) # retries (4 bytes int) { package Data; my $PACK_FORMAT = "IZ64IZ64I"; sub new(%) { my %data = @_; my $self = {firstSeen => $data{firstSeen}, firstHelo => $data{firstHelo}, lastSeen => $data{lastSeen}, lastHelo => $data{lastHelo}, retries => $data{retries}}; bless $self; } sub unpack($) { my $data = shift; my ($firstSeen, $firstHelo, $lastSeen, $lastHelo, $retries) = unpack $PACK_FORMAT, $data; my $self = {firstSeen => $firstSeen, firstHelo => $firstHelo, lastSeen => $lastSeen, lastHelo => $lastHelo, retries => $retries}; bless $self; } } # converts an ip from from 32bits integer to sdq notation # (ip) -> ip [string dotted quad notation] sub ip2sdq($) { $_ = shift; my $a = ($_ >> 24 & 255); my $b = ($_ >> 16 & 255); my $c = ($_ >> 8 & 255); my $d = ($_ & 255); "$a.$b.$c.$d"; } # display a date sub dateSince($) { my $ts = shift; my $date = localtime $ts; my $elapsed = time - $ts; "$date (" . (sprintf "%.1f", ($elapsed / 86400)) . " days ago)"; } # display record parameters sub showData($$) { my ($ip, $data) = @_; my @notes; print "IP: " . (ip2sdq $ip) . "\n" . " First seen:\t" . (dateSince $data->{firstSeen}) . "\n" . " with helo:\t$data->{firstHelo}\n" . " Last seen:\t" . (dateSince $data->{lastSeen}) . "\n" . " with helo:\t$data->{lastHelo}\n" . " Retries:\t$data->{retries}\n"; # tests my $now = time; my $totDays = ($now - $data->{firstSeen}) / 86400; my $elDays = ($now - $data->{lastSeen}) / 86400; my $period = ($data->{lastSeen} - $data->{firstSeen}) / 86400; my $rate = $period / $data->{retries}; # return true if the host is to be expunged my $expunge = (($totDays > 7 && ($period < 1 || $data->{retries} < 2)) || ($elDays > 7 && $rate > 5) || ($elDays > 30)); print " Expunge:\t" . ($expunge? "yes": "no") . "\n"; push @notes, "Identifier mismatch" if($data->{firstHelo} ne $data->{lastHelo}); push @notes, "Old entry" if($totDays > 7); if($data->{firstSeen} == $data->{lastSeen}) { push @notes, (($data->{retries} > 1)? "Hammer": (($elDays < 1)? "First ack": "Seen once")); } else { if($data->{retries} > 1) { push @notes, "Didn't return recently" if($elDays > 30); push @notes, "Lame server" if($period < 0.001); } if($period > 1) { push @notes, "High traffic" if($rate > 5); push @notes, "Low traffic" if($rate < 0.1); } } # display notes print " Notes:\n\t- " . (join "\n\t- ", @notes) . "\n" if(@notes); return $expunge; } # open the database and attach the needed filters # (file) -> tied hash-ref sub openDb($) { # open the db handler my $file = shift; my $ref = tie my %db, "DB_File", $file, (O_RDWR | O_CREAT), 0666, $DB_BTREE; return undef if(!defined $ref); # attach read filters $ref->filter_fetch_key(sub {$_ = unpack("I", $_)}); $ref->filter_store_key(sub {$_ = pack ("I", $_)}); $ref->filter_fetch_value(sub {$_ = Data::unpack $_}); return \%db; } ## ## CLI ## # failure function my $prg = basename $0; sub failure($) { $_ = (join " ", @_); print STDERR "$prg: $_\n"; exit 1; } # process the parameters { my $prg = basename $0; my ($file) = @ARGV; failure "bad parameters" if(!$file || !-r $file); # open the db my $db = openDb $file; failure "unable to tie the db: $!" if(!defined $db); # process all identifiers my $n = 0; my $x = 0; while(my ($ip, $data) = each %$db) { ++$x if(showData $ip, $data); print "\n"; ++$n; } print "$n elements in the db, $x would be expunged (" . (int $x * 100 / $n) . "%).\n"; } wcm-0/wcm0100755000203200000620000000716207761177030011730 0ustar wavexxstaff#!/usr/bin/env perl # Worm Counter Measures # Copyright(c) wave++ "Yuri D'Elia" # Distributed under GNU LGPL v2 or above WITHOUT ANY WARRANTY use strict; use warnings; # Modules use File::Basename; use DB_File; ## ## Implementation ## # Data storage, current data format: # firstSeen (4 bytes int timestamp) # firstHelo (64 bytes string) # lastSeen (4 bytes int timestamp) # lastHelo (64 bytes string) # retries (4 bytes int) { package Data; my $PACK_FORMAT = "IZ64IZ64I"; sub new(%) { my %data = @_; my $self = {firstSeen => $data{firstSeen}, firstHelo => $data{firstHelo}, lastSeen => $data{lastSeen}, lastHelo => $data{lastHelo}, retries => $data{retries}}; bless $self; } sub pack() { my $self = shift; pack $PACK_FORMAT, $self->{firstSeen}, $self->{firstHelo}, $self->{lastSeen}, $self->{lastHelo}, $self->{retries}; } sub unpack($) { my $data = shift; my ($firstSeen, $firstHelo, $lastSeen, $lastHelo, $retries) = unpack $PACK_FORMAT, $data; my $self = {firstSeen => $firstSeen, firstHelo => $firstHelo, lastSeen => $lastSeen, lastHelo => $lastHelo, retries => $retries}; bless $self; } } # converts an ip from sdq notation to 32bits integer # (ip [string dotted quad notation]) -> ip sub sdq2ip($) { $_ = shift; my ($a, $b, $c, $d) = /^(\d+).(\d+).(\d+).(\d+)$/; return undef if(!(defined $a && defined $b && defined $c && defined $d)); ($a << 24) + ($b << 16) + ($c << 8) + $d; } # returns # 0 if the message can be accepted, # 1 if the host entered the defer queue, # 2 to reject (not within retry window or abuse) # # (hash, ip, helo, from, rcpt, timestamp) -> integer my $CHECK_ACCEPT = 0; my $CHECK_DEFER = 1; my $CHECK_REJECT = 2; my $CHECK_RTR_MIN = 3; # minimum retry time in minutes my $CHECK_RTR_MAX = 120; # maximum retry time before expiration sub check($$$$$$) { my ($db, $ip, $helo, $from, $rcpt, $ts) = @_; my $index = \$db->{$ip}; if(!$$index) { # unseen server, set the current timestamp $db->{$ip} = Data::new(firstSeen => $ts, firstHelo => $helo, lastSeen => $ts, lastHelo => $helo, retries => 1); # try again fellow return $CHECK_DEFER; } # fetch the data my $data = $$index; # increment the counters $data->{lastSeen} = $ts; $data->{lastHelo} = $helo; ++$data->{retries}; # save back the data $db->{$ip} = $data; # check the retry window my $mins = ($ts - $data->{firstSeen}) / 60; return ($mins < $CHECK_RTR_MIN? $CHECK_REJECT: $CHECK_ACCEPT); } # open the database and attach the needed filters # (file) -> tied hash-ref sub openDb($) { # open the db handler my $file = shift; my $ref = tie my %db, "DB_File", $file, (O_RDWR | O_CREAT), 0666, $DB_BTREE; return undef if(!defined $ref); # the key is always an integer $ref->filter_fetch_key(sub {$_ = unpack("I", $_)}); $ref->filter_store_key(sub {$_ = pack ("I", $_)}); # use handlers to construct the objects $ref->filter_fetch_value(sub {$_ = Data::unpack $_}); $ref->filter_store_value(sub {$_ = $_->pack}); return \%db; } ## ## CLI ## # failure function my $prg = basename $0; sub failure($) { $_ = (join " ", @_); print STDERR "$prg: $_\n"; exit 1; } # process the parameters { my $prg = basename $0; my ($file, $ip, $helo, $from, $rcpt) = @ARGV; failure "bad parameters" if(!($file && (!-e $file || -w $file) && $ip && $helo && $from && $rcpt)); # open the db my $db = openDb $file; failure "unable to tie the db: $!" if(!defined $db); # return true if we must defer exit (check($db, (sdq2ip $ip), $helo, $from, $rcpt, time) == $CHECK_ACCEPT); }