#!/usr/bin/perl

##########################################################################
#      SMTPMon is a monitor program for the SMTarPit
## $Id: smtpmon,v 0.5.1 2005/03/09 13:21:16 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
#
##########################################################################

use Tk;

# declare subroutines that need it
sub pollstatus ($);
sub statusretrieve ($);
sub updatestatuslist ($);
sub getsmtpproceses ($);
sub initvars ($);
sub dumplog ($);
sub getclhost ($);
sub getclwhois ($);
sub help ($);
sub desthlp ($);
sub autoupdatestart ($);
sub alarmed ($);
sub statusbarud ($);

##### 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 so that you can restrict the number without
# having to restart xinetd. (see Maximum number of instances
# below.)
#
#$progname = "smtarpit";
#
$progname = "noemail";
#$progname = "smtarpit";

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

#### Auto-update interval ####
# This is the interval (in seconds) between updates
# of the PID list (on the left). This searches the processes
# so if you have a slower processor, this can add to the overall
# demand on the system if you set it too low.
# two minutes is all right - depends what you are doing. If you
# leave the SMTP Monitor for a while, you can always turn it off
# using the checkbox at the bottom.
# by default, it starts in the off position.
#
# $autoudinterval = 120;
#
$autoudinterval = 120;

#### Colour scheme ####
# Colours of the background and highlights.
#
#($barcoll, $barcold) = ('white', 'beige');
#($barcoll, $barcold) = ('#FFFFFF', '#D0E0FF');
#($barcoll, $barcold) = ('#FFF8F0', '#B0D0FF');
#($barcoll, $barcold) = ('#F0F8FF', '#FFD0B0');
#($barcoll, $barcold) = ('#F8F8F8', '#bdefc9'); #green 'piano' paper
($barcoll, $barcold) = ('#F8F8F8', '#e8e4a9');
#                                          #
##### END CONFIGURATION ####################

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

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

$autoupdate = 0;
$SIG{'ALRM'} = 'alarmed';
$labwidth = 60;
$hlpfrm = 0;
&initvars;
$amax = 0;
foreach $x (0..12) {
  $a[0][$x] = 80000;
};

$main = MainWindow -> new(-bd => "1");
$main -> title("SMTarPit Monitor");
$main -> resizable(0,0);
$tf = $main -> Frame(-bd => 2) -> pack(-side => 'top');
$lf = $tf -> Frame(-bd => 2, -label => "PIDs", -width => '8') -> pack(-side => 'left');
  $flist1 = $lf->Scrolled('Listbox', -scrollbars => 'e', -selectborderwidth => 0,
                 -bg => $barcoll, -bd => 2, -relief => 'groove', #-anchor => 'w',
                 -selectbackground => $barcold, -highlightbackground => $barcold,
                 -width => 7, -height => 18, -font => 'fixed')-> pack(-fill => 'y');
  $flist1 -> bind( '<Any-Button>' => \&statusretrieve);
$rof = $tf -> Frame(-label => "Process Information . . .") -> pack(-side => 'right');
 $rf = $rof -> Frame(-bd => 2, -relief => 'groove') -> pack(-side => 'right');
  $rft = $rf -> Frame -> pack(-side => 'top');
    $rft1 = $rft -> Frame -> pack(-side => 'top');
      $rft11l = $rft1 -> Label(-bg => $barcoll, -anchor => 'w', -text => 'PID', -width => 20);
        $rft11l -> pack(-side => 'left');
        $rft11l -> bind( '<Any-Button>' => \&pollstatus);
      $rft112 = $rft1 -> Label(-bg => $barcoll, -anchor => 'w', -textvariable => \$pid, -width => $labwidth);
        $rft112 -> pack(-side => 'left');
        $rft112 -> bind( '<Any-Button>' => \&pollstatus);
    $rft2 = $rft -> Frame -> pack(-side => 'top');
      $rft21l = $rft2 -> Label(-bg => $barcold, -anchor => 'w', -text => 'Remote Host', -width => 20);
        $rft21l -> pack(-side => 'left');
      $rft212 = $rft2 -> Label(-bg => $barcold, -anchor => 'w', -textvariable => \$rho, -width => $labwidth);
        $rft212 -> pack(-side => 'left');
    $rft3 = $rft -> Frame -> pack(-side => 'top');
      $rft31l = $rft3 -> Label(-bg => $barcoll, -anchor => 'w', -text => 'Start Time', -width => 20);
        $rft31l -> pack(-side => 'left');
      $rft312 = $rft3 -> Label(-bg => $barcoll, -anchor => 'w', -textvariable => \$stt, -width => $labwidth);
        $rft312 -> pack(-side => 'left');
    $rft4 = $rft -> Frame -> pack(-side => 'top');
      $rft41l = $rft4 -> Label(-bg => $barcold, -anchor => 'w', -text => 'Duration', -width => 20);
        $rft41l -> pack(-side => 'left');
      $rft412 = $rft4 -> Label(-bg => $barcold, -anchor => 'w', -textvariable => \$now, -width => $labwidth);
        $rft412 -> pack(-side => 'left');
    $rft5 = $rft -> Frame -> pack(-side => 'top');
      $rft51l = $rft5 -> Label(-bg => $barcoll, -anchor => 'w', -text => 'Server Name', -width => 20);
        $rft51l -> pack(-side => 'left');
      $rft512 = $rft5 -> Label(-bg => $barcoll, -anchor => 'w', -textvariable => \$snm, -width => $labwidth);
        $rft512 -> pack(-side => 'left');
    $rft6 = $rft -> Frame -> pack(-side => 'top');
      $rft61l = $rft6 -> Label(-bg => $barcold, -anchor => 'w', -text => 'Server Type', -width => 20);
        $rft61l -> pack(-side => 'left');
      $rft612 = $rft6 -> Label(-bg => $barcold, -anchor => 'w', -textvariable => \$stp, -width => $labwidth);
        $rft612 -> pack(-side => 'left');
    $rft7 = $rft -> Frame -> pack(-side => 'top');
      $rft71l = $rft7 -> Label(-bg => $barcoll, -anchor => 'w', -text => 'HELO', -width => 20);
        $rft71l -> pack(-side => 'left');
      $rft712 = $rft7 -> Label(-bg => $barcoll, -anchor => 'w', -textvariable => \$hel, -width => $labwidth);
        $rft712 -> pack(-side => 'left');
    $rft8 = $rft -> Frame -> pack(-side => 'top');
      $rft81l = $rft8 -> Label(-bg => $barcold, -anchor => 'w', -text => 'Reaction Time', -width => 20);
        $rft81l -> pack(-side => 'left');
      $rft812 = $rft8 -> Label(-bg => $barcold, -anchor => 'w', -textvariable => \$dlt, -width => $labwidth);
        $rft812 -> pack(-side => 'left');
    $rft9 = $rft -> Frame -> pack(-side => 'top');
      $rft91l = $rft9 -> Label(-bg => $barcoll, -anchor => 'w', -text => 'Mode', -width => 20);
        $rft91l -> pack(-side => 'left');
      $rft912 = $rft9 -> Label(-bg => $barcoll, -anchor => 'w', -textvariable => \$tgr, -width => $labwidth);
        $rft912 -> pack(-side => 'left');
    $rft10 = $rft -> Frame -> pack(-side => 'top');
      $rft101l = $rft10 -> Label(-bg => $barcold, -anchor => 'w', -text => 'Sender', -width => 20);
        $rft101l -> pack(-side => 'left');
      $rft1012 = $rft10 -> Label(-bg => $barcold, -anchor => 'w', -textvariable => \$snd, -width => $labwidth);
        $rft1012 -> pack(-side => 'left');
    $rft11 = $rft -> Frame -> pack(-side => 'top');
      $rft111l = $rft11 -> Label(-bg => $barcoll, -anchor => 'w', -text => 'Number Recipients', -width => 20);
        $rft111l -> pack(-side => 'left');
      $rft1112 = $rft11 -> Label(-bg => $barcoll, -anchor => 'w', -textvariable => \$nrc, -width => $labwidth);
        $rft1112 -> pack(-side => 'left');
    $rft12 = $rft -> Frame -> pack(-side => 'top');
      $rft121l = $rft12 -> Label(-bg => $barcold, -anchor => 'w', -text => 'Last Recipient', -width => 20);
        $rft121l -> pack(-side => 'left');
      $rft1212 = $rft12 -> Label(-bg => $barcold, -anchor => 'w', -textvariable => \$lrc, -width => $labwidth);
        $rft1212 -> pack(-side => 'left');
    $rft13 = $rft -> Frame -> pack(-side => 'top');
      $rft131l = $rft13 -> Label(-bg => $barcoll, -anchor => 'w', -text => 'Last Updated', -width => 20);
        $rft131l -> pack(-side => 'left');
      $rft1312 = $rft13 -> Label(-bg => $barcoll, -anchor => 'w', -textvariable => \$lup, -width => $labwidth);
        $rft1312 -> pack(-side => 'left');
$sfo = $main -> Frame(-bd => 0);
  $sfo -> pack(-fill => 'x', -side => 'bottom');
  $cb = $sfo->Checkbutton(-bd => 1, -text => "Auto Re-list", -variable => \$autoupdate, -command => \&autoupdatestart);
    $cb -> pack(-fill => 'y', -side => 'left');
  $sf0 = $sfo -> Frame (-width => 6);
    $sf0 -> pack(-side => 'left');
$sf = $sfo -> Frame(-bd => 1 ,-relief => 'sunken');
  $sf -> pack(-fill => 'x', -side => 'bottom');
    $sbl = $sf->Label(-bd => 1, -textvariable => \$sbleft);
      $sbl -> pack(-side => 'left');
    $sbr = $sf->Label(-bd => 1, -textvariable => \$sbright);
      $sbr -> pack(-side => 'right');
$bf = $main -> Frame(-bd => 2) -> pack(-fill => 'x', -side => 'bottom');
  $butrf1 = $bf->Button(-text => "Re-list", -command => \&refreshlist, -width => 6);
    $butrf1 -> pack(-side => 'left');
  $sf1 = $bf -> Frame (-width => 10);
    $sf1 -> pack(-side => 'left');
  $butrf2 = $bf->Button(-text => "Info", -command => \&pollstatus, -width => 6);
    $butrf2 -> pack(-side => 'left');
  $sf2 = $bf -> Frame (-width => 10);
    $sf2 -> pack(-side => 'left');
  $butrf3 = $bf->Button(-text => "Host", -command => \&getclhost, -width => 6);
    $butrf3 -> pack(-side => 'left');
  $butrf4 = $bf->Button(-text => "Whois", -command => \&getclwhois, -width => 6);
    $butrf4 -> pack(-side => 'left');
  $sf3 = $bf -> Frame (-width => 10);
    $sf3 -> pack(-side => 'left');
  $butrf5 = $bf->Button(-text => "Dump Log", -command => \&dumplog, -width => 6);
    $butrf5-> pack(-side => 'left');
  $sf4 = $bf -> Frame (-width => 10);
    $sf4 -> pack(-side => 'left');
  $butrf6 = $bf->Button(-text => "Help", -command => \&help, -width => 6);
    $butrf6 -> pack(-side => 'left');
  $butrf7 = $bf->Button(-text => "Close", -command => 'exit', -width => 6);
    $butrf7 -> pack(-side => 'right');
$mf = $main -> Frame(-bd => 2);
  $mf -> pack(-fill => 'x', -side => 'bottom');
  $clist = $mf->Scrolled('Listbox', -font => 'fixed',
     -bd => 2, -selectborderwidth => 0, -bg => $barcoll,
     -selectbackground => $barcold, -relief => 'groove',
     -height => 9, -scrollbars => 'oe') -> pack(-fill => 'x');
&refreshlist;
MainLoop;

sub help ($) {
  if ($hlpfrm == 1) {
    return;
  };
  $tla = $main -> Toplevel(-bd => "10");
  $tla -> title("Help / SMTarPit Monitor");
  $tlaf0 = $tla ->Frame;
    $tlaf0 -> pack;
  $tt = <<'END_TLAT';
SMTarPit Monitor v0.5.1
for use with SMTarPit v0.5.4

Copyright (c) 2005 P. A. Grosse.
All Rights Reserved.
END_TLAT
  $tt2 = <<'END_TLAT2';
PID LIST...
===========
The list on the upper-left is a list of SMTarPit PIDs.

Click on the PID and this program will signal the tarpit
and get its status - this may take a second or two.

Clicking on a new PID will do the same with that.
If you click on a PID that you have clicked on before,
it will display that data again.

You can force it to get newer data by clicking on the
PID in the Process Information list.

PROCESS INFORMATION...
======================
This is just a display of the information that is
specific to the tarpit specified by the PID.

BUTTONS...
==========
* Re-list - refreshes the PID list.

* Auto Re-list (check button) - refreshes PID list,
    every PPRRPP seconds automatically.
    This is currently RRPPRR.

* Info - refreshes the process information for the
    selected PID.

* Host - uses the host command to gain information
    about the IP address currently displayed in
    Process Information.

    It also checks the domain given in the 'mail from:'
    to retrieve its IP.

    If the IP address matches directly, it will be
    highlighted for you automatically.

* Whois - as host but retrieved netblock information
    including the ABUSE address which is highlighed
    (if there is one).

* Dump Log - signals the current tarpit to dump the
    detailed log information and carry on as though
    nothing had happened.

    Next, you need to look in the log which is stored
    at LLPPLL.

Finally, Help is how you got here and you wouldn't
really want to Close the program, would you?
END_TLAT2
  $tt2 =~ s/PPRRPP/$autoudinterval/;
  if ($autoupdate == 0) {
    $tt2 =~ s/RRPPRR/off/;
  } else {
    $tt2 =~ s/RRPPRR/on/;
  };
  $tt2 =~ s/LLPPLL/$logloc/;
  $tlal = $tla->Label(-text => $tt, -justify =>'center');
    $tlal ->pack;
  $tlalb = $tla->Scrolled('Listbox', -scrollbars => 'e', -selectborderwidth => 0,
                 -bg => $barcoll, -bd => 0,# -relief => 'groove',
                 -selectbackground => $barcoll, -highlightbackground => $barcoll,
                 -height => 18);
    $tlalb ->pack (fill => 'x');
  $tla -> OnDestroy(\&desthlp);
    $tla -> resizable(0,0);
  $tlals = $tla->Label(-text => ' ');
    $tlals ->pack;
  $button1 = $tla->Button(-text => "Ok", -width => 7, -command => [$tla => "destroy"]);
    $button1 -> pack (-anchor => 'e');
  $hlpfrm = 1;
  my $g = 'd';
  @ttg = split /\n/, $tt2;
  {
    my $mw=1;
    foreach $g (@ttg) {
      chomp $g;
      $mw = ($mw > length ($g) ) ? $mw : length ($g) ;
      $g = " ".$g;
      $tlalb->insert('end',$g);
    };
    $mw += 2;
    $tlalb -> configure (-width => $mw, -font => 'fixed');
  };
}

sub statusbarud ($) {
  #check if xinetd is running
  $rp = "ps -e | grep xinetd";
  @prun = readpipe ($rp);
  my $xinets = $#prun + 1;
  if ($xinets == 1) {
    $sbleft = " xinetd Superserver is running.";
  } else {
    $sbleft = " xinetd Superserver is not running.";
  };
  $rp = "ps -e | grep $progname";
  @prun = readpipe ($rp);
  my $hptps = $#prun + 1;
  if ($hptps > 0) {
    $sbright = "$hptps SMTarPit process";
    if ($hptps == 1) {
      $sbright .= " is";
    } else {
      $sbright .= "es are";
    }
  } else {
    $sbright = "No SMTarPit processes are";
  };
  $sbright .= " running. ";
}

sub autoupdatestart ($) {
  if ($autoupdate == 0) {
    alarm 0;
  } else {
    alarm $autoudinterval;
  };
}

sub alarmed ($) {
  &refreshlist;
  &statusbarud;
  $flist1 -> update();
  alarm $autoudinterval;
}

sub desthlp ($) {
  $hlpfrm = 0;
  &statusbarud;
}

sub getclwhois ($) {
  if ($rho =~ m/\d+\.\d+\.\d+\.\d+/) {
    $butrf4-> configure(-text => 'Wait');
    $butrf4-> update();
    $rp = "whois $rho";
    @gch = readpipe ($rp);
    $clist->delete(0,'end');
    $clist->insert('end','GET NETBLOCK INFORMATION FROM IP ADDRESS...');
    my $tt = "\# whois $rho";
    $clist->insert('end',$tt);
    $abuseline = -1;
    $al = 1;
    foreach $rl (@gch) {
      chomp $rl;
      $al++;
      $clist->insert('end',$rl);
      if ($rl =~ m/abuse/i){
       $abuseline = $al;
      };
    };
    $al = 1;
    foreach $rl (@gch) {
      $al++;
      if ($rl =~ m/abuse\@/i){
        $abuseline = $al;
      };
    };
    $al = 1;
    foreach $rl (@gch) {
      $al++;
      if ($rl =~ m/AbuseEmail/i){
        $abuseline = $al;
      };
    };
    $clist->selection('set', $abuseline, $abuseline);
    $clist->see($abuseline);
  };
  &statusbarud;
  $butrf4-> configure(-text => 'Whois');
}

sub getclhost ($) {
  my $li = 4;
  if ($rho =~ m/\d+\.\d+\.\d+\.\d+/) {
    $butrf3-> configure(-text => 'Wait');
    $butrf3-> update();
    $rp = "host $rho";
    @gch = readpipe ($rp);
    $clist->delete(0,'end');
    $clist->insert('end','GET NAME FROM IP ADDRESS...');
    my $tt = "\# host $rho";
    $clist->insert('end',$tt);
    foreach $rl (@gch) {
      chomp $rl;
      $clist->insert('end',"    $rl");
      $li++;
    };
  };
  $butrf3-> configure(-text => 'And...');
  $butrf3-> update();
  $clist -> update();
  if ($hel =~ m/[[\w\d\_]{2,30}\.[\w]{2,4}/) {
    $rp = "host $hel";
    @gch = readpipe ($rp);
    my $tt = "\# host $hel";
    $clist->insert('end',' ');
    $clist->insert('end','GET IP ADDRESS FROM NAME...');
    $clist->insert('end',$tt);
    $limatch = -1;
    foreach $rl (@gch) {
      chomp $rl;
      $clist->insert('end',"    $rl");
      $li++;
      $rl =~ m/(\d+\.\d+\.\d+\.\d+)/;
      $rhotest = $1;
      if (defined ($rhotest)) {
        if ($rho eq $rhotest) {
          $limatch = $li;
        };
      };
    };
    unless ($limatch == -1) {
      $clist->selection('set', $limatch, $limatch);
      $clist->see($limatch);
    };
  };
  &statusbarud;
  $butrf3-> configure(-text => 'Host');
}

sub statusretrieve ($) {
  &initvars (1);
  $clist->delete(0,'end');
  &updatestatuslist;
  $clist -> update();
  my $found = -1;
  my $p = $flist1 -> curselection();
  if (defined $p and $p > -1) {
    $pid = $flist1 -> get($p);
    $pid =~ s/\s*(\d+)$/$1/;
    $flist1 -> activate($p);
    # find if it already exists
    foreach $x (0..$amax) {
      if ($a[$x][0] == $pid) {
        $found = $x;
        last;
      };
    };
    if ($found == -1) {
      $pid =' - ';
      &pollstatus;
    } 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];
    };
  };
  $clist -> update();
  &statusbarud;
}

sub updatestatuslist ($) {
  $rf->update();
}

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


sub refreshlist ($) {
  my ($rl, $re);
  # make a note of the PID that is already selected
  my $p = -5;
  $p = $flist1 -> curselection();
  if (defined($p) and ($p > -1)) {
    $p = $flist1 -> get($p);
    $p =~ s/\s*(\d+)$/$1/;
  } else {
    $p = -1;
  };
  &getsmtpprocesses;
  # clear out list
  $flist1->delete(0,'end');
  if ($#prun > -1) {
    @prun = sort { $a <=> $b } @prun;
    # sort @prun;
    # fill list
    my ($a, $pp) = (-1, -1);
    foreach $rl (@prun) {
      $a++;
      chomp $rl;
      $rl =~ m/(\d+)/;
      $re = $1;
      if ($p > -1) {
        if ($p == $re) {
          $pp = $a;
        };
      };
      my $rejs = (' 'x5).$re;
      $rejs = substr($rejs, length($rejs)-6, 6);
#      $rejs =~ s/.*(([.]{5,5}))$\s*/$1/;
      $flist1->insert('end',$rejs);
    };
    if ($pp > -1) {
      $flist1->selection('set', $pp, $pp);
      $flist1->see($pp);
    };
    #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;
      };
    };
  };
  &statusbarud;
}

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 (@prun) {
    s/(\d+).+/$1/;
  };
}

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 pollstatus ($) {
  # get the PID of the process required
  $butrf2 -> configure(-text => 'Wait...');
  $butrf2 -> update();
  &initvars (1);
  $clist->delete(0,'end');
  $clist->update();
  my $p = -5;
  $p = $flist1 -> curselection();
  if (defined($p) and ($p > -1)) {
    $pid = $flist1 -> get($p);
    # check that it still exists
    $pid =~ s/\s*(\d+)$/$1/;
    &getsmtpprocesses;
    my $found = 0;
    foreach $x (@prun) {
      if ($pid == $x) {
        $found = 1;
        last;
      };
    };
    # send a signal USR2 to the required process
    if ($found == 0) {
      $pid = "SMTarPit Process $pid no longer exists.";
      &refreshlist;
      $butrf2 -> configure(-text => 'Info');
      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);
      $pid = "$pd process not responding";
      $butrf2 -> configure(-text => 'Info');
      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;
  };
  &statusbarud;
  $butrf2 -> configure(-text => 'Info');
}
