parse postfix maillog to detect hacked accounts

surveille-spam.pl

#!/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";
  }
}