[PATCH] Added a reporting tool for botnow

[izzyb <izzyb@xxxxxxxxxxxxxxx>]

report.pl reads the botnow database and znc log file to produce a
dossier on the specified user(s).  It accepts a space seperated list
of user names to generate reports on.

This is a WIP but is useful tool at this stage.  It produces a dossier
as described in https://wiki.ircnow.org/index.php?n=Police.Fingerprints

Usage:
doas report.pl username [username]...
---
 report.pl | 121 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 121 insertions(+)
 create mode 100755 report.pl

diff --git a/report.pl b/report.pl
new file mode 100755
index 0000000..0787940
--- /dev/null
+++ b/report.pl
@@ -0,0 +1,121 @@
+#!/usr/bin/perl
+#
+use strict;
+#no strict 'refs';
+use warnings;
+use Data::Dumper;
+# Bsd pledge/unveil security modules
+use OpenBSD::Pledge;
+use OpenBSD::Unveil;
+
+# Database modules
+use DBI;
+use DBD::SQLite;
+
+# setup log level constents
+use constant {
+    NONE => 0,
+    ERRORS => 1,
+    WARNINGS => 2,
+    ALL => 3,
+};
+my $verbose = ERRORS;
+sub debug {
+       my ($level, $msg) = @_;
+       if ($verbose >= $level) { print "$msg\n"; }
+}
+
+#
+use lib './';
+
+my ($ipTable, $nameTable) = init_ip_xref();
+
+while (my $username = shift) {  #param 1 should be the name of a user 
to generate a report from.
+               my $dbFile = '/var/www/botnow/botnow.db';
+               my $dbh = connectdb($dbFile);
+               if (!defined($dbh))  {
+                       die "failed to connect to $dbFile";
+               }
+               my $stmt=qq{select * from bnc join irc on (bnc.ircid = 
irc.id) where username is ?};
+               my $sth=$dbh->prepare($stmt);
+               $sth->execute($username) or die "execution failed: 
$dbh->errstr()";
+               while (my $row=$sth->fetchrow_hashref) {
+                       my $dossier =qq{
+               Username: $row->{username}
+               Email Address: $row->{email}
+               $row->{hostmask}
+               $row->{ctcpversion}
+               $row->{ctcptime}
+               Registration Date: $row->{date}
+               };
+                       print $dossier;
+                       print "Same Email ["
+                               . join(', ', 
@{$dbh->selectcol_arrayref(qq\Select username from bnc join irc on 
(bnc.ircid = irc.id) where email = ?\,undef,$row->{email})})
+                               . "]\n";
+                       print "Same Date ["
+                               . join(', ', 
@{$dbh->selectcol_arrayref(qq\Select username from bnc join irc on 
(bnc.ircid = irc.id) where date = ?\,undef,$row->{date})})
+                               . "]\n";
+                       print "Same Hostmask ["
+                               . join(', ', 
@{$dbh->selectcol_arrayref(qq\Select username from bnc join irc on 
(bnc.ircid = irc.id) where hostmask = ?\,undef,$row->{hostmask})})
+                               . "]\n";
+                       print Dumper($row);
+                       print "Frequency of connections from: \n" . 
Dumper($nameTable->{$username});
+                       print "Other Users connecting from: \n";
+ foreach(keys(%{$nameTable->{$username}})) {
+                               print "$_ =>[" . join (', ', 
keys(%{$ipTable->{$_}})) . "]\n";
+                       }
+               }
+}
+
+
+
+
+exit 0;
+
+sub connectdb {
+       my $dbpath=shift;
+       my $dsn      = "dbi:SQLite:dbname=$dbpath";
+       my $user     = "";
+       my $password = "";
+       my $dbh = DBI->connect($dsn, $user, $password, {
+               PrintError       => 1,
+               RaiseError       => 1,
+               AutoCommit       => 1,
+               FetchHashKeyName => 'NAME_lc',
+       }) or die "Couldn't connect to database: " . $DBI::errstr;
+       if (!(-s "$dbpath")) {
+               main::debug(ALL, "Cant locate $dbpath");
+               exit 1;
+       }
+       main::debug(ALL, "connected to $dbpath");
+       return $dbh;
+}
+# Read and index the znc log file.
+sub init_ip_xref {
+       # Get IP addresses
+       my $ip2usernames={};
+       my $usernames2ip={};
+       open my $zncLog, '<', 
'/home/znc/home/znc/.znc/moddata/adminlog/znc.log' or die "Can't open 
znc log file";
+       while (my $line = <$zncLog>) {
+                       if( $line =~/.*\[(.*)\] connected to ZNC from 
(.*)/) {
+                                       my $name=$1;
+                                       my $ip=$2;
+                                       if 
(!defined($ip2usernames->{$ip})) {
+ $ip2usernames->{$ip} = {};
+                                       }
+                                       if 
(!defined($ip2usernames->{$name})) {
+ $ip2usernames->{$ip}->{$name}=0;
+                                       }
+ $ip2usernames->{$ip}->{$name}++;
+                                       if 
(!defined($usernames2ip->{$name})) {
+ $usernames2ip->{$name}={};
+                                       }
+                                       if 
(!defined($usernames2ip->{$name}->{$ip})) {
+ $usernames2ip->{$name}->{$ip}=0;
+                                       }
+ $usernames2ip->{$name}->{$ip}++;
+                       }
+       }
+       close $zncLog;
+       return $ip2usernames,$usernames2ip;
+}
--
2.37.3