qpsmtpd/plugins/ident/p0f

# -*- perl -*-

=pod

An Identification Plugin

 ./p0f -u qpsmtpd -d -q -Q /tmp/.p0f_socket 'dst port 25' -o /dev/null && \
    chown qpsmtpd /tmp/.p0f_socket

and add 

 ident/p0f /tmp/.p0f_socket 

to config/plugins

it puts things into the 'p0f' connection notes so other plugins can do
things based on source OS.

All code heavily based upon the p0fq.pl included with the p0f distribution.

=head1 Environment requirements

p0f requires four pieces of information to look up the p0f fingerprint:
local_ip, local_port, remote_ip, and remote_port. TcpServer.pm has been
has been updated to provide that information when running under djb's
tcpserver. The async, forkserver, and prefork models will likely require
some additional changes to make sure these fields are populated.

=cut

use IO::Socket;
use Net::IP;

my $QUERY_MAGIC = 0x0defaced;

sub register {
  my ($self, $qp, $p0f_socket) = @_;

  $p0f_socket =~ /(.*)/; # untaint
  $self->{_args}->{p0f_socket} = $1;
}

sub hook_connect {
  my($self, $qp) = @_;

  my $p0f_socket = $self->{_args}->{p0f_socket};
  my $srcport    = 
  my $destport   = $self->qp->connection->local_port;

  my $src = new Net::IP ($self->qp->connection->remote_ip) 
    or $self->log(LOGERROR, "p0f: ".Net::IP::Error()), return (DECLINED);
  my $dst = new Net::IP ($self->qp->connection->local_ip) 
    or $self->log(LOGERROR, "p0f: ".NET::IP::Error()), return (DECLINED);
  my $query = pack("L L L N N S S",
                   $QUERY_MAGIC, 
                   1, 
                   rand ^ 42 ^ time,
                   $src->intip(), 
                   $dst->intip(), 
                   $self->qp->connection->remote_port,
                   $self->qp->connection->local_port);

  # Open the connection to p0f
  socket(SOCK, PF_UNIX, SOCK_STREAM, 0) 
    or $self->log(LOGERROR, "p0f: socket: $!"), return (DECLINED);
  connect(SOCK, sockaddr_un($p0f_socket)) 
    or $self->log(LOGERROR, "p0f: connect: $!"), return (DECLINED);
  defined syswrite SOCK, $query 
    or $self->log(LOGERROR, "p0f: write: $!"), close SOCK, return (DECLINED);

  my $response;
  defined sysread SOCK, $response, 1024 
    or $self->log(LOGERROR, "p0f: read: $!"), close SOCK, return (DECLINED);
  close SOCK;

  # Extract the response from p0f
  my ($magic, $id, $type, $genre, $detail, $dist, $link, $tos, $fw,
      $nat, $real, $score, $mflags, $uptime) =
        unpack ("L L C Z20 Z40 c Z30 Z30 C C C s S N", $response);

  if ($magic != $QUERY_MAGIC) {
	$self->log(LOGERROR, "p0f: Bad response magic.");
	return (DECLINED);
  }
  if ($type == 1) {
	$self->log(LOGERROR, "p0f: P0f did not honor our query");
	return (DECLINED);
  }
  if ($type == 2) {
	$self->log(LOGWARN, "p0f: This connection is no longer in the cache");
	return (DECLINED);
  }

  my $p0f = { 
      genre    => $genre,
      detail   => $detail,
      distance => $dist,
      link     => $link,
      uptime   => $uptime,
  };

  $self->qp->connection->notes('p0f', $p0f);
  $self->log(LOGINFO, "Results: ".$p0f->{genre}." (".$p0f->{detail}.")");
  $self->log(LOGERROR,"error: $@") if $@;

  return DECLINED;
}