#!/usr/bin/perl

##########################################################################
#      SMTPCLI is a CLI monitor program for the SMTarPit
## $Id: smtpmon,v 0.0.1 2005/03/09 06:56:15 paul_grosse$
#
# Copyright (C) 2005 Paul Grosse
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; either version 2 of the
# License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public
# License along with this program; if not, write to the Free
# Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA  02111-1307  USA.
#
# You can email Paul Grosse on: pagrosse at compuserve dot com
#
##########################################################################

##### CONFIGURATION ########################
#                                          #

#### The SMTarPit program's name ####
# the name of the executable that will be seen in the process
# list. This is so that it can look to see how many tarpits
# already exist.
#
#$progname = "smtarpit";
#
$progname = "noemail";
#$progname = "smtarpit";

#### Log file's location ####
# Detailed log location.
#
# $logloc = "/usr/local/etc/log";
#
$logloc = "/usr/local/etc/log";

#                                          #
##### END CONFIGURATION ####################

# you shouldn't need to touch anything below here under normal
# circumstances but you can look and improve if you want.

##### CHECK COMMAND LINE ###################
#                                          #

$nl = "\n";
foreach (@ARGV) {
  /^-h/ and do {
    #command line help
    print "SMTPCLI monitors SMTarPit processes on the system.\n\n";
    print "The command line options are:\n";
    print "-h to get you this help (when you run the program, there is context\n";
    print "    sensitive help); and,\n";
    print "-c which uses a crlf at the end of the line instead of just a new\n";
    print "    line. if the terminal you are using needs it.\n\n";
    exit;
  };
  /^-c/ and do {
    $nl = "\n\r";
  };
};

##### INITIALISATION #######################
#                                          #

&initvars;
$amax = 0;
$smode = 0;
foreach $x (0..12) {
  $a[0][$x] = 80000;
};

## make STDOUT respond immedeately
select(STDOUT);
$| = 1;

##### GO FOR IT ############################
#                                          #

# print out program header
&poprghead ();
# go into loop
while (<STDIN>) {
  if (length($_) == 0) {
    next;
  };
  $_ = lc $_;
  s/\r//g;
  s/^ +//g;
  s/ +$//g;
  /^s/ and do {
    # print status line
    &statusline();
  };
  /^l/ and do {
    # list PIDs as a table that can be referenced
    &getsmtpprocesses();
    #check that we have something worth printing out
    if ($#prun >= 0) {
      # print header
      print $nl."SMTarPit PID List...$nl";
      my $c = $#prun + 1;
      if ($c > 10) {
        $c = 9;
      } else {
        $c--;;
      };
      foreach $x (0..$c) {
        print "     $x ";
      };
      print $nl;
      #print PIDs
      my ($z, $zc) = (-1, -1);
      while ($zc < $#prun) {
        $z++;
        unless ($z > 25) {
          print " ".chr(65 + $z);
        } else {
          my $msb = chr(64 + (($z - ($z % 26)) / 26 ));
          my $lsb = chr(65 + ($z % 26));
          print $msb.$lsb;
        };

        foreach (0..9) {
          $zc++;
          if ($zc <= $#prun) {
            my $pprun
             = $prun[$zc];
            printf "  %5d", $pprun;
          };
        };
        print $nl;
      };
      print $nl;
      $smode = 1;
    } else {
      print "No SMTarPit processes running$nl";
      $smode = 0;
    };
  };
  /^c/ and do {
    # choose a pid from the list
    if ($smode ==1) {
      &getpid;
    };
  };
  /^d/ and do {
    # pid details
    if ($smode >=2) {
      &getdetails;
    };
  };
  /^r/ and do {
    # refresh pid details
    if ($smode >2) {
      &refreshdetails;
    };
  };
  /^o/ and do {
    # host
    if ($smode >=3) {
      &getclhost;
    };
  };
  /^w/ and do {
    #whois
    if ($smode >=3) {
      &getclwhois;
    };
  };
  /^h/ and do {
    #help
    &printhelp;
  };
  /^q/ and do {
    print "          SMTarPit Monitor CLI version 0.0.1 quitting.$nl";
    exit;
  };
  &listcmds();
};
exit;

sub getclwhois ($) {
  if ($rho =~ m/\d+\.\d+\.\d+\.\d+/) {
    $rp = "whois $rho";
    @gch = readpipe ($rp);
    print "GET NETBLOCK INFORMATION FROM IP ADDRESS...$nl\# whois $rho$nl";
    $abuseline = -1;
    $al = 0;
    foreach $rl (@gch) {
      chomp $rl;
      $al++;
      print $rl.$nl;
      if ($rl =~ m/abuse/i){
       $abuseline = $al;
      };
    };
    $al = 0;
    foreach $rl (@gch) {
      $al++;
      if ($rl =~ m/abuse\@/i){
        $abuseline = $al;
      };
    };
    $al = 0;
    foreach $rl (@gch) {
      $al++;
      if ($rl =~ m/AbuseEmail/i){
        $abuseline = $al;
      };
    };
    unless ($abuseline == -1) {
      print "$nl        ABUSE INFORMATION LINE:$nl".$gch[$abuseline-1].$nl;
    };
  };
}

sub getclhost ($) {
  my $li = 4;
  if ($rho =~ m/\d+\.\d+\.\d+\.\d+/) {
    $rp = "host $rho";
    @gch = readpipe ($rp);
    print "NAME FROM IP ADDRESS...$nl\# host $rho$nl";
    foreach $rl (@gch) {
      chomp $rl;
      print $rl.$nl;
    };
  };
  if ($hel =~ m/[[\w\d\_]{2,30}\.[\w]{2,4}/) {
    $rp = "host $hel";
    @gch = readpipe ($rp);
    print "GET IP ADDRESS FROM NAME...$nl\# host $hel$nl";
    $limatch = -1;
    foreach $rl (@gch) {
      chomp $rl;
      print "    $rl$nl";
      $rl =~ m/(\d+\.\d+\.\d+\.\d+)/;
      $rhotest = $1;
      if (defined ($rhotest)) {
        if ($rho eq $rhotest) {
          $limatch = $li;
        };
      };
    };
    unless ($limatch == -1) {
      print "        IP MATCHED$nl";
    };
  };
}

sub getdetails () {
  # retrieve details from array or, failing that, from PID
  my $found = -1;
  my $p = $pid;
  &initvars (1);
  if ($smode >= 2) {
    # find if it already exists
    foreach $x (0..$amax) {
      if ($a[$x][0] == $pid) {
        $found = $x;
        last;
      };
    };
    if ($found == -1) {
      &refreshdetails;
    } else {
      # store it
      $pid = $a[$found][0];
      $rho = $a[$found][1];
      $stt = $a[$found][2];
      $now = $a[$found][3];
      $snm = $a[$found][4];
      $stp = $a[$found][5];
      $hel = $a[$found][6];
      $dlt = $a[$found][7];
      $tgr = $a[$found][8];
      $snd = $a[$found][9];
      $nrc = $a[$found][10];
      $lrc = $a[$found][11];
      $lup = $a[$found][12];
      &printvars ();
    };
  };
}


sub refreshlist ($) {
  # look at current PIDs and mark any redundant entries in array
  my ($rl, $re);
  unless ($smode >= 2) {
    return;
  };
  &getsmtpprocesses;
  if ($#prun > -1) {
    # fill list
    my ($a, $pp) = (-1, -1);
    #remove any redundant entries from array
    foreach $x (0..$amax) {
      $found = 0;
      foreach $rl (@prun) {
        if ($rl == $a[$x][0]) {
          $found = 1;
        };
      };
      if ($found == 0) {
        $a[$x][0] = 80000;
      };
    };
  };
}

sub refreshdetails () {
  # get details from the PID live
  # get the PID of the process required
  &initvars (1);
  my $p = $pid;
  if ($smode >= 2) {
    &getsmtpprocesses;
    my $found = 0;
    foreach $x (@prun) {
      if ($pid == $x) {
        $found = 1;
        last;
      };
    };
    # send a signal USR2 to the required process
    if ($found == 0) {
      print "SMTarPit Process $pid no longer exists.$nl";
      &refreshlist;
      return;
    };
    kill USR2 => $pid;
    $x = 0;
    while ($x < 4) {
      sleep 1;
      open(PSTAT, "<$logloc/pstat");
        @ps = <PSTAT>;
      close(PSTAT);
      foreach (@ps) {
        chomp;
      };
      $ps[0] =~ m/(PID)\s+([\d]{1,5})/;
      if ($pid == $2) {
        $found = 1;
        last;
      };
      $x++;
    };
    if ($found == 0) {
      my $pd = $pid;
      &initvars (1);
      print "$pd process not responding$nl";
      return;
    };
    $ps[1] =~ m/(RHOST)\s+(.+)/;
    $rho = $2;
    $ps[2] =~ m/(START)\s+(.+)/;
    $stt = substr(localtime($2), 20, ) . " " . substr(localtime($2), 4, -5);
    $sttv = $2;
    $ps[3] =~ m/(NOW)\s+(.+)/;
    my $nwtv = $2;
    my $n = ($2 - $sttv);
    my $m = $n;
    1 while ($m =~ s/(\d+)(\d\d\d)/$1,$2/);
    if ($n > 1500) {
      $n = " (" . (int ($n / 360 + .5) / 10 ) . " hours)";
    } else {
      $n = "";
    };
    $now = $m . " seconds$n";
    $ps[4] =~ m/(SNAME)\s+([\w\s.]+)/;
    $snm = $2;
    $ps[5] =~ m/(STYPE)\s+(.+)/;
    $stp = $2;
    if ($ps[6] =~ m/NOHELO/) {
      $hel = "No HELO or EHLO yet";
    } else {
      $ps[6] =~ m/(HELO)\s+(.+)/;
      $hel = $2;
    };
    if ($ps[7] =~ m/NODELTAT/) {
      $dlt = "No valid response yet";
    } else {
      $ps[7] =~ m/(DELTAT)\s+([0-9]{1,5})/;
      $dt = $2;
      $dlt = $dt . " second";
      if ($dt != 1) {
        $dlt .= "s";
      };
    };
    $ps[8] =~ m/(TEERGRUBE)\s+(.+)/;
    $m = $2;
    if ($m =~ m/(TARPIT|HONEYPOT)/) {
      $tgr = "\u\L$m";
    } else {
      $tgr = "Not determined yet";
    };
    if ($ps[9] =~ m/NOSENDER/) {
      $snd = "No sender yet (mail from:)";
    } else {
      $ps[9] =~ m/(SENDER)\s+(.+)/;
      $snd = $2;
    };
    $ps[10] =~ m/(NUMRECIPS)\s+([0-9]{1,7})/;
    $nrc = $2;
    $ps[11] =~ m/(LASTRECIP)\s+(.+)/;
    $lrc = $2;
    $lup = substr(localtime($nwtv), 20, ) . " " . substr(localtime($nwtv), 4, -5);
    # save data in array
    # find if it already exists
    $mt = 80000;
    $found = -1;
    foreach $x (0..$amax) {
      if ($a[$x][0] == $pid) {
        $found = $x;
        last;
      } elsif ($a[$x][0] == 80000){
        $mt = $x;
      };
    };
    if ($found == -1) {
      if ($mt == 80000) {
        $amax++ ;
        $found = $amax;
      } else {
        $found = $mt;
      };
    };
    # store it
    $a[$found][0] = $pid;
    $a[$found][1] = $rho;
    $a[$found][2] = $stt;
    $a[$found][3] = $now;
    $a[$found][4] = $snm;
    $a[$found][5] = $stp;
    $a[$found][6] = $hel;
    $a[$found][7] = $dlt;
    $a[$found][8] = $tgr;
    $a[$found][9] = $snd;
    $a[$found][10] = $nrc;
    $a[$found][11] = $lrc;
    $a[$found][12] = $lup;
    &printvars();
  };
}

sub printvars () {
  print "PID ... ... ... ... : $pid$nl";
  print "Remote Host ... ... : $rho$nl";
  print "Start Time. ... ... : $stt$nl";
  print "Duration... ... ... : $now$nl";
  my $tsnm = $snm;
  if (length($snm) > 55) {
    $tsnm = substr($snm,0,55)."...";
  };
  print "Server Name ... ... : $tsnm$nl";
  print "Server Type ... ... : $stp$nl";
  print "HELO... ... ... ... : $hel$nl";
  print "Reaction Time.. ... : $dlt$nl";
  print "Mode... ... ... ... : $tgr$nl";
  print "Sender. ... ... ... : $snd$nl";
  print "Number of Recipients: $nrc$nl";
  print "Last Recipient  ... : $lrc$nl";
  print "Last Updated... ... : $lup$nl";
  my $tn = substr(localtime(time), 20, ) . " " . substr(localtime(time), 4, -5);
  print "Time Now... ... ... : $tn$nl";
  $smode =3;
}

sub getpid () {
  print "Enter Co-ordinates (eg A5 or AC8).                              [H]elp, [Q]uit.".$nl."TPEC>>";
  my $found_index;
  while (<STDIN>) {
    $cl = uc($_);
    chomp($cl);
    ($cl =~ /^Q$/) and do {
       $_ = "";
       return;
    };
    ($cl =~ /^H$/) and do {
      print "Choose Help...$nl$nl";
      print "Look at the PID you are interested in, in the list of SMTarPit PIDs.$nl";
      print "Type in its co-ordinates as though it was a spreadsheet eg a5.".$nl.$nl;
      print "[Q]uit takes you out of the Choose command, not out of the program.$nl$nl";
      print "TPEC>>";
      next;
    };
    if ($cl =~ m/^([A-Z]{1,2})([0-9]{1,1})$/) {
      #coordinates used
      my ($lhs, $rhs) = ($1, $2);
      if (length($lhs) == 2) {
        $found_index = ((ord(substr($lhs,0,1))-64)*26)+(ord(substr($lhs,1,1))-64);
        $found_index *= 10;
        $found_index += $rhs;
      } elsif (length($lhs) == 1) {
        $found_index = (ord($lhs) - 65) * 10 + $rhs;
      };
      if ($found_index > $#prun) {
        print "Value Outside Range".$nl."TPEC>>";
      } else {
        $pid = $prun[$found_index];
        $smode = 2;
        last;
      };
    } else {
      print "Command Not Recognised".$nl."TPEC>>"
    };
  };
}

sub poprghead ($) {
  print $nl.(" "x16)."Welcome to SMTarPit Monitor CLI version 0.0.1.";
  print $nl.(" "x14)."Copyright (c)2005 Paul Grosse. All rights reserved.".$nl.$nl;
  &statusline();
  &listcmds(0);
}

sub listcmds($) {
  if ($smode == 0) {
    print "[S]tatus, [L]ist PIDs,                                          [H]elp, [Q]uit.".$nl."TP>";
  } elsif ($smode == 1) {
    print "[S]tatus, [L]ist PIDs, [C]hoose PID,                            [H]elp, [Q]uit.".$nl."TP>";
  } elsif ($smode == 2) {
    print "[S]tatus, [L]ist PIDs, [D]etails,                               [H]elp, [Q]uit.".$nl.$pid.">>";
  } elsif ($smode == 3) {
    print "[S]tatus, [L]ist PIDs, [D]etails, [R]efresh, H[o]st, [W]hois,   [H]elp, [Q]uit.".$nl.$pid.">>";
  };
}

sub printhelp($) {
    print "$nl               SMTarPit v0.0.1 Context Sensitive Help...$nl$nl";
  if ($smode == 0) {
    print "[S]tatus displays the number of SMTarPit processes on the system;$nl$nl";
    print "[L]ist displays the PIDs of the SMtarPit processes currently running in the$nl";
    print " format of a spreadsheet where each row of PIDs is identified by a letter (or$nl";
    print " letter-pair if you allow that many processes to run) and each column of PIDs$nl";
    print " is identified by a number;$nl$nl";
    print "[H]elp displays context-sensitive help; and,$nl$nl";
    print "[Q]uit exits the program, taking you back to the command line.$nl$nl";
  } elsif ($smode == 1) {
    print "[S]tatus displays the number of SMTarPit processes on the system;$nl$nl";
    print "[L]ist displays the PIDs of the SMtarPit processes currently running in the$nl";
    print " format of a spreadsheet where each row of PIDs is identified by a letter (or$nl";
    print " letter-pair if you allow that many processes to run) and each column of PIDs$nl";
    print " is identified by a number;$nl$nl";
    print "[C]hoose allows you to select a PID for further examination. To use it,$nl";
    print " press [C], then [Enter] and then the co-ordinates as described in [L]ist$nl";
    print " above -- for example A3 or B6. It is not case-sensitive.$nl$nl";
    print "[H]elp displays context-sensitive help; and,$nl$nl";
    print "[Q]uit exits the program, taking you back to the command line.$nl$nl";
  } elsif ($smode == 2) {
    print "[S]tatus displays the number of SMTarPit processes on the system;$nl$nl";
    print "[L]ist displays the PIDs of the SMtarPit processes currently running in the$nl";
    print " format of a spreadsheet where each row of PIDs is identified by a letter (or$nl";
    print " letter-pair if you allow that many processes to run) and each column of PIDs$nl";
    print " is identified by a number;$nl$nl";
    print "[D]etails polls the process and then displays the process details such as$nl";
    print " remote host, duration, HELO, mode (tarpit/honeypot), sender and so on.$nl";
    print " This information is stored in an array so that when you ask for the details$nl";
    print " again it is returned without delay.$nl$nl";
    print "[H]elp displays context-sensitive help; and,$nl$nl";
    print "[Q]uit exits the program, taking you back to the command line.$nl$nl";
  } elsif ($smode == 3) {
    print "[S]tatus displays the number of SMTarPit processes on the system;$nl$nl";
    print "[L]ist displays the PIDs of the SMtarPit processes currently running in the$nl";
    print " format of a spreadsheet where each row of PIDs is identified by a letter (or$nl";
    print " letter-pair if you allow that many processes to run) and each column of PIDs$nl";
    print " is identified by a number;$nl$nl";
    print "[D]etails polls the process and then displays the process details such as$nl";
    print " remote host, duration, HELO, mode (tarpit/honeypot), sender and so on.$nl";
    print " This information is stored in an array so that when you ask for the details$nl";
    print " again it is returned without delay.$nl$nl";
    print "[R]efresh polls the process again, generating a new list of details for that$nl";
    print " process which replaces the old details.$nl$nl";
    print "H[o]st (enter the letter \'o\') uses the host command to check the IP address$nl";
    print " for a domain name and vice versa, printing both and if there is a match,$nl";
    print " stating that there is.$nl";
    print " * Note that this information is not stored.$nl$nl";
    print "[W]hois uses the whois command to retrieve netblock information from the IP$nl";
    print " address or the remote host. If there is an abuse address or line in the$nl";
    print " retrieved information, this will be repeated by this program at the end of the$nl";
    print " whois block of output.$nl$nl";
    print " * Note that this information is not stored.$nl$nl";
    print "[H]elp displays context-sensitive help; and,$nl$nl";
    print "[Q]uit exits the program, taking you back to the command line.$nl$nl";
  };
}

sub statusline ($) {
  #get the time in standard format
  my $curtime = substr(localtime(time), 20, ) . " " . substr(localtime(time), 4, -5);
  #check if xinetd is running
  my $rp = "ps -e | grep xinetd";
  @prun = readpipe ($rp);
  my $xinets = $#prun + 1;
  if ($xinets == 1) {
    $sbleft = "";
  } else {
    $sbleft = "not ";
  };
  $rp = "ps -e | grep $progname";
  @prun = readpipe ($rp);
  my $hptps = $#prun + 1;
  if ($hptps > 0) {
    $sbright = "$hptps SMTarPit";
    unless ($hptps == 1) {
      $sbright .= "s";
    };
  } else {
    $sbright = "No SMTarPits";
  };
  $sbright .= " running.";
  print "Time: $curtime;     xinetd is ".$sbleft."running;     $sbright$nl";
}

sub initvars ($) {
  my $asd = shift;
  # initialise the variables
  unless (defined($asd) and ($asd == 1)) {$pid = ' - '};
  ($rho,  $stt,  $now,  $snm,  $stp,  $hel,  $dlt,  $tgr,  $snd,  $nrc,  $lrc,  $lup) =
  (' - ', ' - ', ' - ', ' - ', ' - ', ' - ', ' - ', ' - ', ' - ', ' - ', ' - ', ' - ');
}

sub getsmtpprocesses ($) {
  ## find out how many processes exist
  # and put the result in the list box
  $rp = "ps -e | grep $progname";
  @prun = readpipe ($rp);
  foreach $x (@prun) {
    $x =~m/(\d+)/;
    $x = $1;
  };
  if ($#prun>-1) {
    @prun = sort { $a <=> $b } @prun;
  };
}

# >>>>>>>>>>>>>>>>>>>New Above>>>>>>>>>>>>>>>>>>>>>>>>>>>>

sub dumplog ($) {
  if ($pid =~ m/\d+/) {
    kill USR1 => $pid;
  };
}
