eval 'exec perl -x $0 ${1+"$@"}' # -*-perl-*-
  if 0;
#!perl -w
#
# ======================================================================
# This file is Copyright 1998,1999 by the Purdue Research Foundation and
# may only be used under license.  For terms of the license, see the
# file named COPYRIGHT included with this software release.
# AAFID is a trademark of the Purdue Research Foundation.
# All rights reserved.
# ======================================================================
#
# Filter::ActiveSockets;
#
# AAFID project, COAST Laboratory, CERIAS, 1998-1999.
#
# Diego Zamboni, Mar 31, 1999
#
# $Id: ActiveSockets.pm,v 1.4 1999/09/08 04:45:14 zamboni Exp $
#
# NOTE: This file is in Perl's POD format. For more information, see the 
#       manual page for perlpod(1).
#

package Filter::ActiveSockets;

use strict;
use AAFID::Filter;
use AAFID::Entity;
use AAFID::Common;
use vars qw(
	%PARAMETERS
	@ISA
	$ps
	    );

%PARAMETERS=(
	     Period  => 5,
	     Command => "netstat -a",
	    );

@ISA=qw(AAFID::Filter);

=pod

This filter executes the "netstat" command periodically and reports the
active socket connections for UDP, TCP and Unix-domain sockets.

All records contain a field "ProcessID" which contains the PID of the
command that produced the record.

For UDP sockets, the fields are defined as follows:

=over 4

=item Domain

Is always "UDP".

=item LocalAddr

As reported by netstat, of the form "host.port".

=item LocalHost

The local host for the socket (the part before the dot in LocalAddr).

=item LocalPortNum, LocalPortName

The local port number and name (if any) for the socket (obtained from
the part after the dot in LocalAddr).

=item State

The state as reported by netstat.

=back 4

For TCP sockets, the fields are defined as follows:

=over 4

=item Domain

Is always "TCP"

=item LocalAddr, LocalHost, LocalPortNum, LocalPortName

Same as before.

=item RemoteAddr, RemoteHost, RemotePortNum, RemotePortName

Equivalent for the remote end of the socket.

=item Swind, Rwind

Send and receive windows for the socket, in bytes.

=item SendQ, RecvQ

Send and receive queue sizes for the socket, in bytes.

=item State

The state of the connection, one of CLOSED, LISTEN, SYN_SENT,
SYN_RCVD, ESTABLISHED, CLOSE_WAIT, FIN_WAIT_1, CLOSING, LAST_ACK,
FIN_WAIT_2 and TIME_WAIT

=back 4

For Unix-domain sockets, the fields are as follows:

=over 4

=item Domain

Is always "UNIX"

=item Address

The address of the socket, as reported by netstat (a hex number).

=item Type

The type of the socket, as reported by netstat.

=item Vnode

The Vnode field of the netstat report.

=item Conn

The Conn field of the netstat report.

=item Path

The path of the socket, if any.

=back 4

The lines sent to the agents that subscribe to the filter have the
following formats:

=over 4

=item For UDP:

  UDP localhost localportnum localportname status

=item For TCP:

  TCP localhost localportnum localportname remotehost remoteportnum remoteportname swind sendq rwind recvq state

=item For UNIX:

  UNIX address type vnode conn path

=back 4

Note that the "LocalAddr" and "RemoteAddr" fields are not included, because
they can be reconstructed from LocalHost and LocalPort*. However, these
fields are still represented internally, so they can be used in patterns.

=cut

sub Init_log {
  my $self=checkref(shift);
  my $netstat=IO::File->new;
  my $pid;
  $pid=$netstat->open($self->getParameter('Command') . " |") or return undef;
  # Store the PID of the process as a parameter
  $self->setParameter(ProcessID => $pid);
  Comm::Reactor::add_acceptor($netstat, 
	      sub {
		my ($fh)=shift;
		my $msg=<$fh>;
		if (!defined($msg)) {
		  Comm::Reactor::remove_handle($fh);
		  $fh->close;
		  # Reawake in a little bit.
		  Comm::Reactor::add_event(time()+$self->getParameter('Period'),
					   sub {$self->Init_log});
		}
		else {
		  chomp $msg;
		  # Only process appropriate lines.
		  $self->processLine($fh, $msg);
		}
	      });
  return $self;
}

=head1 Processing lines

In this case, the lines are interpreted differently depending on which
section of the input we are. So C<makefield> keeps state, and returns
C<undef> for non-interesting lines, such as headers.

=cut

# Split something of the form "host.port" into its components and map
# the port to both number and name, if possible.
sub _do_addr {
  my $self=shift;
  my $proto=lc(shift);
  my $addr=shift;
  my ($host, $port)=split(/\./, $addr);
  my $portnum;
  my $portname;
  return undef if !defined($host) || !defined($port);
#  print "proto=$proto; addr=$addr; host=$host; port=$port\n";
  if ($port =~ /^\d+$/) {
    # we have a numeric port
    ($portname, undef, $portnum, undef)=getservbyport $port, $proto;
  }
  else {
    # we have a port name
    ($portname, undef, $portnum, undef)=getservbyname $port, $proto;
  }
  return ($addr || "-", $host || "-", $portnum || 0, $portname || "-");
}

sub makefield {
  my $self=checkref(shift);
  my $line=shift;
  my %fields;

  # Skip blank lines and separator lines (composed only of space an hyphens)
  return undef if $line =~ /^[\s-]*$/;

  if ($line =~ /^UDP/) {
    # We are entering the UDP section
    $self->{_Section}="UDP";
    return undef;
  }
  if ($line =~ /^TCP/) {
    # We are entering the TCP section
    $self->{_Section}="TCP";
    return undef;
  }
  if ($line =~ /^Active UNIX domain/) {
    # Entering the UNIX section
    $self->{_Section}="UNIX";
    return undef;
  }
  
  # Check for headers
  my $section=$self->{_Section};
  if ($section eq "UDP" || $section eq "TCP") {
    return undef if $line =~ /Local Address/;
  }
  elsif ($section eq "UNIX") {
    return undef if $line =~ /Address.*Vnode/;
  }
  else {
    # Weird, non-blank line before the first section.
    return undef;
  }

  # Now, process the line according to the type.
  $fields{Domain}=$section;
  $fields{ProcessID}=$self->getParameter('ProcessID');
  my @tmp=split(" ",$line);
  if ($section eq "UDP") {
    ($fields{LocalAddr}, $fields{LocalHost}, $fields{LocalPortNum}, 
     $fields{LocalPortName})=$self->_do_addr($section, $tmp[0]);
    $fields{State}=$tmp[1];
    return check_and_ref(%fields);
  }
  if ($section eq "TCP") {
    ($fields{LocalAddr}, $fields{LocalHost}, $fields{LocalPortNum},
     $fields{LocalPortName})=$self->_do_addr($section, $tmp[0]);
    ($fields{RemoteAddr}, $fields{RemoteHost}, $fields{RemotePortNum},
     $fields{RemotePortName})=$self->_do_addr($section, $tmp[1]);
    $fields{Swind}=$tmp[2];
    $fields{SendQ}=$tmp[3];
    $fields{Rwind}=$tmp[4];
    $fields{RecvQ}=$tmp[5];
    $fields{State}=$tmp[6];
    return check_and_ref(%fields);
  }
  if ($section eq "UNIX") {
    ($fields{Address}, $fields{Type}, $fields{Vnode}, $fields{Conn},
     $fields{Path})=@tmp;
    return check_and_ref(%fields);
  }
  # If we get here, something is wrong.
  $self->Log("errors", "I am in section '$section', and got line '$line', something is wrong.\n");
  return undef;
}

# Check that no element is undef, and return a reference to the hash
sub check_and_ref {
  my %hash=@_;
  my $k;
  foreach $k (keys %hash) {
    return undef if !defined($hash{$k});
  }
  return \%hash;
}

sub makeline{
  my $self=checkref(shift);
  my $line=shift;
  my %line=%$line;
  if (uc($line{Domain}) eq "UDP") {
    return "UDP $line{ProcessID} $line{LocalHost} $line{LocalPortNum} $line{LocalPortName} $line{State}";
  }
  elsif (uc($line{Domain}) eq "TCP") {
    return "TCP $line{ProcessID} $line{LocalHost} $line{LocalPortNum} $line{LocalPortName} $line{RemoteHost} $line{RemotePortNum} $line{RemotePortName} $line{Swind} $line{SendQ} $line{Rwind} $line{RecvQ} $line{State}";
  }
  elsif (uc($line{Domain}) eq "UNIX") {
    return "UNIX $line{ProcessID} $line{Address} $line{Type} $line{Vnode} $line{Conn} $line{Path}";
  }
  else {
    # Something is wrong
    $self->Log("errors", "makeline: Got an array with Domain=$line{Domain}, I don't know what to do.\n");
    return undef;
  }
}

_EndOfEntity;

#
# $Log: ActiveSockets.pm,v $
# Revision 1.4  1999/09/08 04:45:14  zamboni
# Made Init_log return the appropriate value (undef if error, $self otherwise)
#
# Revision 1.3  1999/09/03 17:08:59  zamboni
# Changed the start line to something that is path-independent, and
# updated the copyright notice.
#
# Revision 1.2  1999/06/08 05:02:05  zamboni
# Merged branch a06-raw-data-collection into main trunk
#
# Revision 1.1.2.1  1999/06/07 20:02:50  zamboni
# - Made it include the PID of the netstat process in each line, to help
#   the agent differentiate between executions of the command.
# - Added error checks.
#
# Revision 1.1  1999/04/01 02:43:50  zamboni
# - Added
#
#
