Last active
December 12, 2022 09:49
-
-
Save dgeo/9642c4c8ed84c7678ec29ccdd175cab4 to your computer and use it in GitHub Desktop.
parse postfix maillog to detect hacked accounts
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/bin/env perl | |
# | |
# surveilleur de logins sasl: compte les IP's de provenance d'un meme login | |
# | |
# needs geoip2 perl module and GeoLite2-Country.mmdb (use geoipupdate) | |
# | |
# run by cron on a daily-rotated maillog: | |
# 2 */1 * * * root /usr/local/admin/ssi/surveille-spam.pl /data/logs/serveurs/maillog | |
# 1 0 * * * root /usr/local/admin/ssi/surveille-spam.pl /data/logs/serveurs/maillog.0 | |
use strict; | |
use warnings; | |
use utf8; | |
use GeoIP2::Database::Reader; | |
use Net::CIDR::Lite; | |
use DateTime; | |
############### | |
# CONFIG | |
############### | |
my $adminmail="ssi\@univ.fr"; | |
# blocage du compte si deux limites atteintes: | |
# | |
## args: ip [ip [ip] ...] | |
my $lock_ip_script="/usr/local/admin/ssi/lock_ip.sh"; | |
## args: lock|unlock login [reason] | |
my $lock_user_script="/usr/local/admin/ssi/lock_account.sh"; | |
# nb de logins max / jour | |
my $ALERTLOGINS=80; | |
# nb de /16 (/48 en IPv6) differents pour un meme login / jour | |
my $ALERTNETWORKS=5; | |
# Nb de destinataires max / jour | |
my $ALERTDESTS=500; | |
# Nb de pays de provenance max / jour | |
my $ALERTPAYS=3; | |
my $ALERTPAYS2=4; | |
# reseaux connus de spammeurs (blocage direct) | |
my @spamnets = ( | |
'^37\.9\.53\.', | |
); | |
# nb tentatives avant lock bruteforce | |
my $brutemin = 30; | |
# reseaux a ne pas bloquer (geoip=FR pour rfc1918) | |
my $rfc1918 = Net::CIDR::Lite->new('10.0.0.0/8', '172.16.0.0/12', '192.168.0.0/16'); | |
my $our_nets4 = Net::CIDR::Lite->new('10.0.0.0/8', '172.16.0.0/12', '192.168.0.0/16', '147.94.18.0/23', '147.94.24.0/22', '147.94.32.0/21'); | |
my $our_nets6 = Net::CIDR::Lite->new('2001:660:5404::/48'); | |
# log du script | |
my $logfile = "/var/log/surveille-spam.log"; | |
############### | |
# END CONFIG | |
############### | |
# | |
open(MYLOG,">>",$logfile) or die("impossible d'ecrire $logfile: $!"); | |
sub loggue() { | |
my $dt = DateTime->now; | |
my $msg = shift; | |
print MYLOG $dt->ymd." ".$dt->hms." ".$msg."\n"; | |
} | |
# hash id=login | |
my $users={}; | |
# pour chercher un user depuis un ID (match par la destination) | |
my $idsmatch={}; | |
# liste des serveurs qui nous jettent | |
my $blockingrelays={}; | |
# listes message-id <-> id | |
my $msgids={}; | |
my $idsmsg={}; | |
# le gros hash par id d'origine | |
my $ids={}; | |
if (@ARGV != 1) { | |
print STDERR "usage: $0 maillog\n"; | |
exit; | |
} | |
# GeoIP2 | |
my $geodb = "/usr/share/GeoIP/GeoLite2-Country.mmdb"; | |
if ( ! -f $geodb ) { | |
$geodb = "/usr/local/share/GeoIP/GeoLite2-Country.mmdb"; | |
} | |
my $geo2 = GeoIP2::Database::Reader->new( file => $geodb ); | |
# hash bruteforce | |
my $bruteforcers={}; | |
open(LOG,"<".$ARGV[0]) or die "J'arrive pas a ouvrir ".$ARGV[0]."\n"; | |
# le fichier en entree | |
while (<LOG>) { | |
if (/postfix\/cleanup\[\d+\]: (?<id>[0-9A-F]+): message-id=<(?<msgid>[^>]+)>/) { | |
# on garde le premier id pour chaque message-id | |
$msgids->{$+{msgid}} = $+{id} unless (defined($msgids->{$+{msgid}})); | |
# et le message-id pour chaque id | |
$idsmsg->{$+{id}} = $+{msgid}; | |
} | |
# on cree la liste des destinataires | |
elsif (/[01] postfix\/smtp\[\d+\]: (?<id>[0-9A-F]+): to=<(?<to>[^>]*)>,/) { | |
push @{$ids->{$+{id}}->{dests}},$+{to} if (defined($ids->{$+{id}})); | |
} | |
# si la ligne matche, on enregistre $+{client},$+{user} pour chaque id | |
elsif (/director[01] postfix\/(?:smtps\/|submission\/)?smtpd\[\d+\]: (?<id>[0-9A-F]+): client=[^\[]*\[(?<client>.*)\], sasl_method=\w+, sasl_username=(?<user>.*)/) { | |
# un hash pour chaque id | |
$ids->{$+{id}}={ 'src' => $+{client}, 'user' => $+{user}, 'dests' => [] } unless (defined($ids->{$+{id}})); | |
} | |
# si on voit ca on est grilles... | |
elsif (/^(?<stamp>.*) postfix\/smtp\[\d+\]: (?<id>[0-9A-F]+): (?<reason>.* UCEPROTECT-Network.*)$/) { | |
$idsmatch->{$msgids->{$idsmsg->{$+{id}}}} = { 'reason' => $+{reason}, 'stamp' => $+{stamp} }; | |
} | |
# la on sait que c'est un spammeur a cause de la reponse du serveur destinataire (520 ou 56* ou 57*) | |
elsif (/^^(?<stamp>.*) postfix\/smtp\[\d+\]: (?<id>[0-9A-F]+): to=<(?<to>[^>]+)>, relay=(?<relay>[^\[]+)\[(?<relayip>[\d\.:]+)\]:\d+, delay.*, dsn=(?<dsn>5\.(?:2\.0|[567]\.\d)), status=.*said: (?<reason>.*)$/) { | |
$idsmatch->{$msgids->{$idsmsg->{$+{id}}}} = { 'reason' => $+{reason}." by".$+{relayip}, 'stamp' => $+{stamp} } unless ((!defined($msgids->{$idsmsg->{$+{id}}})) || (defined($idsmatch->{$idsmsg->{$+{id}}}))); | |
$blockingrelays->{$+{relayip}} = $+{reason} unless (defined($blockingrelays->{$+{relayip}})); | |
} | |
elsif (/^(?<stamp>.*) postfix\/(?:smtps\/|submission\/)?smtpd\[\d+\]: .*\[(?<client>[\d\.:]+)\]:.* authentication failed: $/) { | |
push @{$bruteforcers->{$+{client}}}, $+{stamp}; | |
} | |
# on peut aussi chercher autrechose | |
# elsif (/sasl_username/) { | |
# print; | |
# } | |
} | |
close(LOG); | |
my @idsrejected=keys(%$idsmatch); | |
# on parcours les ids | |
foreach my $idn (keys %$ids) { | |
my $id = $ids->{$idn}; | |
# on initialise un hash pour chaque utilisateur | |
if (!defined($users->{$id->{user}})) { | |
$users->{$id->{user}}={ 'src' => [], # clients (ip) | |
'pays' => [], # pays de provenance | |
'nets' => [], # reseaux de connexion | |
'ids' => [], # id's de messages associes | |
'reasons' => [], # raisons de le bloquer | |
'rejectedmails' => [], # mails refuses pour spam | |
'dests' => [] }; # adresses destinataires | |
} | |
# ... pour matcher le /16, pas l'IP complete | |
my $net; | |
if ( $id->{src} =~ /\:/ ) { | |
( $net = $id->{src} ) =~ s/^([0-9a-f]+\:[0-9a-f]*\:[0-9a-f]*\:).*$/$1/ if ($id->{src} =~ /\:/); | |
} else { | |
( $net = $id->{src} ) =~ s/\d+\.\d+$//; | |
} | |
( my $regnet = $net ) =~ s/\./\\\./g; | |
# fabrique une regex sur le champ "client" | |
( my $reg = $id->{src} ) =~ s/\./\\\./g; | |
$reg=qr(^$reg); | |
$regnet=qr(^$regnet); | |
# si le client n'a pas deja ete vu, on l'ajoute au user | |
if (!grep(/$reg/,@{$users->{$id->{user}}->{src}})) { | |
push(@{$users->{$id->{user}}->{src}},$id->{src}); | |
# et on remplit les pays de provenance | |
my $pays="UNKNOWN"; | |
if ($rfc1918->find($id->{src})) { | |
$pays="FR"; | |
} else { | |
$pays = $geo2->country(ip=>$id->{src})->country()->iso_code(); | |
} | |
if (($pays) && (! grep /^$pays$/, @{$users->{$id->{user}}->{pays}})) { | |
push @{$users->{$id->{user}}->{pays}}, $pays; | |
} | |
} | |
# idem pour le reseau | |
push(@{$users->{$id->{user}}->{nets}},$net) if (!grep(/$regnet/,@{$users->{$id->{user}}->{nets}})); | |
# les mails rejetes par leur destination | |
if (grep /^$idn$/, @idsrejected) { | |
push @{$users->{$id->{user}}->{rejectedmails}}, $idsmatch->{$idn}; | |
} | |
# on colle les destinataires du message au user | |
foreach my $tmpdst (@{$id->{dests}}) { | |
push @{$users->{$id->{user}}->{dests}}, $tmpdst unless (grep(/^\Q$tmpdst\E$/,@{$users->{$id->{user}}->{dests}})); | |
} | |
# on garde un pointeur sur l'id (=> nb de logins) | |
push @{$users->{$id->{user}}->{ids}}, $id; | |
} | |
# on parcours le hash %$users | |
foreach my $u (keys %{$users}) { | |
# si le client est un reseau connu de spammeurs (compte triple) | |
foreach my $r (@spamnets) { | |
if (grep(/$r/,@{$users->{$u}->{src}})) { | |
push @{$users->{$u}->{reasons}}, "!!! adresse trop connue de nos services ($r) !!!"; | |
} | |
} | |
# .. et on note ceux qui depassent les seuils | |
if ($ALERTNETWORKS <= @{$users->{$u}->{nets}}) { | |
push @{$users->{$u}->{reasons}}, @{$users->{$u}->{ids}}." connexions depuis *".@{$users->{$u}->{nets}}."* reseaux differents (".@{$users->{$u}->{src}}."IPs)"; | |
} | |
if ($ALERTPAYS <= @{$users->{$u}->{pays}}) { | |
push @{$users->{$u}->{reasons}}, @{$users->{$u}->{pays}}." pays differents (".join(',',@{$users->{$u}->{pays}}).")"; | |
if ($ALERTPAYS2 <= @{$users->{$u}->{pays}}) { | |
push @{$users->{$u}->{reasons}}, " second seuil (".@{$users->{$u}->{pays}}." \> ".$ALERTPAYS2.")"; | |
} | |
} | |
if ($ALERTLOGINS <= @{$users->{$u}->{ids}}) { | |
push @{$users->{$u}->{reasons}}, @{$users->{$u}->{ids}}." connexions SMTP depuis 00h00 aujourd'hui"; | |
} | |
if ($ALERTDESTS <= @{$users->{$u}->{dests}}) { | |
push @{$users->{$u}->{reasons}}, @{$users->{$u}->{dests}}." destinataires differents en ".@{$users->{$u}->{ids}}." envois"; | |
# IP webmail en dur | |
if ( ( $ALERTDESTS * 2 < @{$users->{$u}->{dests}} ) && | |
grep(/^(147\.94\.19\.5[89]|2001:660:5404:191::999[34])/,@{$users->{$u}->{src}}) && | |
( @{$users->{$u}->{src}} lt 2 ) | |
) { | |
push @{$users->{$u}->{reasons}}, " ... seuil triple + tout depuis le webmail"; | |
} | |
} | |
} | |
# on construit la sortie | |
my @output; | |
my $cassecouilles = []; | |
# on liste les bruteforces | |
foreach my $bf (keys(%$bruteforcers)) { | |
if ( ( @{$bruteforcers->{$bf}} > $brutemin ) && (! ( $our_nets4->find($bf) || $our_nets6->find($bf) ) ) ) { | |
#push @output,"IP $bf bloquee (".@{$bruteforcers->{$bf}}." essais rates)\n"; | |
&loggue("IP $bf bloquee (".@{$bruteforcers->{$bf}}." essais rates)"); | |
push @$cassecouilles, $bf; | |
} | |
} | |
# on liste les comptes a probleme | |
foreach my $u (keys %{$users}) { | |
# 1 raison: on affiche | |
if (@{$users->{$u}->{reasons}} ge 1) { | |
push @output,"\n*$u*:\n"; | |
# 2 raisons: on bloque | |
if (@{$users->{$u}->{reasons}} ge 2) { | |
push @output, "*Compte $u bloque*\n"; | |
&loggue("*Compte $u bloque*"); | |
my $reason = join ',',@{$users->{$u}->{reasons}}; | |
my @out=`$lock_user_script lock $u "$reason"`; | |
print STDERR "¡¡¡ erreur de '$lock_user_script lock $u \"$reason\"' !!!\n" unless ($? eq 0); | |
print STDERR @out; | |
push @output,@out; | |
} | |
push @output," * ".join("\n * ",@{$users->{$u}->{reasons}})."\n"; | |
# on affiche les 20 premiers destinataires | |
my $last = @{$users->{$u}->{dests}}-1; | |
if (int(@{$users->{$u}->{dests}}) > 20) { | |
$last=20; | |
} | |
push @output," ".@{$users->{$u}->{pays}}." pays de connexion: ".join(' ',@{$users->{$u}->{pays}})."\n"; | |
push @output," ".@{$users->{$u}->{dests}}." destinataires: ".join(' ',@{$users->{$u}->{dests}}[0..$last])."\n"; | |
# 20 sources | |
push @output," ".@{$users->{$u}->{ids}}." connexions depuis: ".join(' ',@{$users->{$u}->{src}})."\n"; | |
} else { | |
delete($users->{$u}); | |
} | |
} | |
my @ccout; | |
if (@$cassecouilles) { | |
my $liste = join(' ',@$cassecouilles); | |
my @iplocked = `$lock_ip_script $liste 2>&1`; | |
print STDERR "### Impossible d'executer '$lock_ip_script $liste' !!!\n" unless ($? eq 0); | |
push @iplocked,@ccout; | |
&loggue("casse-couille: ".$liste); | |
} | |
if (@output eq 0) { | |
exit 0; | |
} | |
# afficher si on a un terminal | |
# (on peut faire plus fin: http://www.perlmonks.org/?node_id=472045) | |
if (-t *STDOUT) { | |
print @output; | |
} | |
# sinon envoyer un mail | |
else { | |
if (require Mail::Send) { | |
my $msg=Mail::Send->new(To => $adminmail, Subject => '[ALERTE]spam: '.join(" ",keys %{$users})); | |
$msg->add('Reply-To',$adminmail); | |
my $fh=$msg->open; | |
print $fh @output; | |
print $fh @ccout; | |
$fh->close or die "Imposible d'envoyer le mail: $!"; | |
} else { | |
print @output; | |
print @ccout; | |
print STDERR "Installer Mail::Send pour envoyer le mail"; | |
} | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment