GOPHERSPACE.DE - P H O X Y
gophering on gopher.linkerror.com
#!/usr/bin/perl -w

use strict;
use Net::PcapUtils;
use NetPacket::TCP;
use Net::Pcap;
use NetPacket::IP qw (:strip);
use NetPacket::Ethernet qw (:strip);
use Fcntl;

# Settings. -------------------------------------------------------------------

my @ip_addresses = qw(123.123.123.123);  # change this to your server ip
my $interface = "eth1";                  # change this to the interface you are sniffing
my $logfile = "/var/log/mailproto.log"; 
my $port = "25";                         

# Globals. --------------------------------------------------------------------

my $filter;
my $pcap;

# Subroutines. ----------------------------------------------------------------

# Prepares pcap and compiles filter.
sub cap_pkt 
{
  my ($pcap,$err,$mask,$net,$filter2);
  my $snaplen = 4096; 
  my $promisc = 1; 
  my $timeout = 500; 
  # get netmask for filter
  if ((Net::Pcap::lookupnet($interface, \$net, \$mask, \$err)) == -1 ) 
  {
    die ("Net::Pcap::lookupnet failed ($err) for device '$interface'\n");
  }
  # open pcap.
  $pcap = Net::Pcap::open_live($interface, $snaplen, $promisc, $timeout, \$err);
  if (!($pcap)) 
  {
    die ("can't create packet fd ($err) on  '$interface'\n");
  } 
  else 
  {
    print "dumping on '$interface'\n";
  }
  # make filter struct
  if (Net::Pcap::compile($pcap, \$filter2, $filter, 1, $mask) != '0') 
  {
    die ("broken filter ($filter)\n");
  }
  # apply
  Net::Pcap::setfilter($pcap, $filter2);
  return $pcap;
}

# Pcap callback function. Gets called by Net::Pcap::loop
sub proc_pkt 
{
  my($user_data, $hdr, $pkt) = @_;
  # Extract packet information.
  my ($user,$msg);
  my $eth = NetPacket::Ethernet->decode($pkt);
  my $ip = NetPacket::IP->decode($eth->{data});
  my $tcp_obj = NetPacket::TCP->decode(ip_strip(eth_strip($pkt)));
  my $ofh = select LOG;
  my $dst = $ip->{dest_ip};
  my $src = $ip->{src_ip};
  my @data = split(/\n/,$tcp_obj->{data});
  # For each line of captured text, prepend the IP address to which the
  # text was sent, and write it to the logfile.
  # This makes it easier to see which text is part of 
  # which conversation stream when looking at the log file.
  foreach(@data)
  {   
    my $data = $_;
    $| = 1; 
    print LOG "$src->$dst | $data\n";
    $| = 0;
    select $ofh;
  }
}

# Cleanup function. After an interrupt signal was captured, make sure we clean 
# up after ourselves.
sub cleanup
{
  print "cleaning up...";
  Net::Pcap::close($pcap);
  close(LOG); 
}

# Entry point -----------------------------------------------------------------

# output file
open (LOG,">>$logfile");
# daemonize
exit if (fork());
exit if (fork());
sleep 1 until getppid() == 1;
print "mailsniff $$ running...\n";
# Trap interrupts so we can cleanup before exiting.
$SIG{'INT'} = \&cleanup;
# Building up the pcap filter string.
# This section will build up the ip filter list based on the
# list of ip addresses defined in the @ip_addresses array.
my $ip_filters = "";
foreach my $ip(@ip_addresses)
{
  $ip_filters .= "(src host $ip) or (dst host $ip) or";
}
# Cut off the last 'or'.
chop($ip_filters);
chop($ip_filters);
# Now compose the rest of the filter.
$filter = "tcp and ( ($ip_filters) and (dst port $port) )";
# Start the pcap sniffing loop.
$pcap = &cap_pkt;
if (!($pcap)) 
{
  die ("cant capture\n");
}
Net::Pcap::loop($pcap, -1, \&proc_pkt, 0);