#------------------------------------------------------------------------------
# This SpamAssassin plugin fingerprint the OS of first untrusted smtp relay host 
# to your MX server and add that info in meta header X-P0f-OS-Fingerprint, 
# then user can add regex to match the OS fingerprint info to catch spam relay 
# through Windows OS.
#
# Read comment in p0f-analyzer.pl from Mark Martinec's  <mark.martinec@ijs.si> amavisd-new
# source package  on how to run p0f and p0f-analyzer on your MX host to cache the OS
# information of smtp client

#   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.

#
# Author, Vincent Li <vli@vcn.bc.ca> June-25-2007
#
#
#------------------------------------------------------------------------------

=head1 NAME

SpamAssassin P0f Plugin - perform smtp client OS check of messages

=head1 SYNOPSIS

  loadplugin     /etc/mail/spamassassin/P0f.pm 

=head1 DESCRIPTION

P0f v2 is a versatile passive OS fingerprinting tool.

p0f-analyzer.pl, a program to continuously read log reports from p0f
utility, keep results in cache for a couple of minutes, and answer queries
over UDP from some program (like amavisd-new) about collected data.

See http://lcamtuf.coredump.cx/p0f.shtml 
See http://www.ijs.si/software/amavisd/release-notes.txt

=cut

package P0f;

use Mail::SpamAssassin::Plugin;
use Mail::SpamAssassin::Logger;
use Socket qw(AF_INET SOCK_DGRAM inet_aton sockaddr_in);
use Time::HiRes ();
use strict;
use warnings;
use bytes;

use vars qw(@ISA);
@ISA = qw(Mail::SpamAssassin::Plugin);

sub new {
    my $class        = shift;
    my $mailsaobject = shift;

    $class = ref($class) || $class;
    my $self = $class->SUPER::new($mailsaobject);
    bless( $self, $class );

    $self->set_config( $mailsaobject->{conf} );

    return $self;

}

sub set_config {
    my ( $self, $conf ) = @_;
    my @cmds = ();

=head1 USER OPTIONS

=over 4

=item use_p0f (0|1)           (default: 1)

Whether to use p0f, if it is available.

=cut

    push(
        @cmds,
        {
            setting => 'use_p0f',
            default => 1,
            type    => $Mail::SpamAssassin::Conf::CONF_TYPE_BOOL
        }
    );

=item p0f_timeout n           (default: 0.050)

How many seconds you wait for p0f to complete, before scanning continues
without the p0f results.

=cut

    push(
        @cmds,
        {
            setting => 'p0f_timeout',
            default => 0.050,
            type    => $Mail::SpamAssassin::Conf::CONF_TYPE_NUMERIC
        }
    );

=item p0f_host           (default: 127.0.0.1)

Which MX host that p0f runs at.

=cut

    push(
        @cmds,
        {
            setting => 'p0f_host',
            default => '127.0.0.1',
            code    => sub {
                my ( $self, $key, $value, $line ) = @_;
                if ( $value !~ m{^(\d+\.\d+\.\d+\.\d+)$} ) {
                    return $Mail::SpamAssassin::Conf::INVALID_VALUE;
                }
                $self->{p0f_host} = $1;
              }
        }
    );

=item p0f_port n           (default: 2345)

Which port that p0f-analyzer listen.

=cut

    push(
        @cmds,
        {
            setting => 'p0f_port',
            default => '2345',
            code    => sub {
                my ( $self, $key, $value, $line ) = @_;
                if ( $value !~ m{^(\d+)$} ) {
                    return $Mail::SpamAssassin::Conf::INVALID_VALUE;
                }
                $self->{p0f_port} = $1;
              }
        }
    );

    $conf->{parser}->register_commands( \@cmds );

}

sub is_p0f_available {
    my ($self) = @_;

    if ( $self->{main}->{conf}->{use_p0f} ) {
        dbg("p0f: use_p0f option enabled, enabling p0f");
        return 1;
    }
    return 0;
}

sub extract_metadata {
    my ( $self, $pms ) = @_;

    return 0 if ( !$self->is_p0f_available );

    my $msg = $pms->{msg};

    if (@{$msg->{metadata}->{relays_untrusted}} > 0 ) {


        my ($cl_ip) = $msg->{metadata}->{relays_untrusted}->[0]->{ip}; 

        my ($p0f_host)    = $self->{main}->{conf}->{p0f_host};
        my ($p0f_port)    = $self->{main}->{conf}->{p0f_port};
        my ($p0f_timeout) = $self->{main}->{conf}->{p0f_timeout};
   
        if (   defined($p0f_host)
            && defined($p0f_port)
            && $cl_ip ne ''
            && $cl_ip ne '0.0.0.0'
            && $cl_ip ne '::' )
        {
            my $nonce =
              int( rand(1000000000) );    # not too clever, but good enough
            my $os_fingerprint_obj =
              $self->_p0f_init( $pms, $p0f_host, $p0f_port, $p0f_timeout,
                $cl_ip, $nonce );
            if ( defined($os_fingerprint_obj) ) {
                my $os_fingerprint =
                  $self->_p0f_collect_response( $pms, $os_fingerprint_obj );
                $msg->put_metadata("X-P0f-OS-Fingerprint", $os_fingerprint);
                dbg("metadata: X-P0f-OS-Fingerprint: $os_fingerprint");
                
                return 1;
            }
        }

    }
}

sub parsed_metadata {
  my ($self, $pms) = @_;
  $pms->{permsgstatus}->set_tag ("P0FOSFINGERPRINT",
          $pms->{permsgstatus}->get_message->get_metadata('X-P0f-OS-Fingerprint'));
  return 1;
}

# Prepares an UDP socket and sends a query with SMTP client IP address
# information to a daemon p0f-analyzer.pl, which is keeping a cache of
# gathered intelligence on recent incoming TCP connections to our MTA.
sub _p0f_init() {
    my ( $self, $pms, $host, $port, $timeout, $query, $nonce ) = @_;
    my ($sock);
    dbg( "p0f: p0f query: %s port=%s %s %s", $host, $port, $query, $nonce );

    # get protocol number
    my $proto = getprotobyname('udp');

    # create the generic socket
    socket( $sock, AF_INET, SOCK_DGRAM, $proto )
      or die "Can't create INET socket: $!";
    my ($hisiaddr) = inet_aton($host) or die "p0f - unknown host: $host";
    my ($hispaddr) = scalar( sockaddr_in( $port, $hisiaddr ) );
    defined( send( $sock, "$query $nonce", 0, $hispaddr ) )
      or die "p0f - send: $!";
    {
        sock       => $sock,
        wait_until => ( Time::HiRes::time + $timeout ),
        query      => $query,
        nonce      => $nonce
    };
}

# Collect a response from p0f-analyzer.pl which provides best guess about
# remote host operating system, based on passive OS fingerprinting (p0f);
# The p0f-analyzer.pl comes with amavisd-new, but is a standalone daemon and
# is covered by a liberal BSD license (see RELEASE_NOTES of amavisd-new for
# details on p0f usage).
sub _p0f_collect_response() {
    my ( $self, $pms, $obj ) = @_;
    my ($timeout) = $obj->{wait_until} - Time::HiRes::time;
    if ( $timeout < 0 ) { $timeout = 0 }
    my ($sock) = $obj->{sock};
    my ( $resp, $nfound );
    my ( $rin,  $rout );
    $rin = '';
    vec( $rin, fileno($sock), 1 ) = 1;

    while ( $nfound = select( $rout = $rin, undef, undef, $timeout ) ) {
        my ($inbuf);
        my ($rv) = recv( $sock, $inbuf, 1024, 0 );
        defined $rv or die "p0f - error receiving from socket: $!";
        if ( $inbuf =~ /^([^ ]*) ([^ ]*) (.*)\015\012\z/ ) {
            my ( $r_query, $r_nonce, $r_resp ) = ( $1, $2, $3 );
            if ( $r_query eq $obj->{query} && $r_nonce eq $obj->{nonce} ) {
                $resp = $r_resp;
            }
        }
        dbg( "p0f: p0f collect: max_wait=%.3f, %.35s... => %s",
            $timeout, $inbuf, $resp );
        $timeout = 0;
    }
    defined $nfound or die "p0f - select on socket failed: $!";
    $resp;
}

1;