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

# run p0f as p0f -l 'dst port 25' -Q /var/run/p0f.sock -0 >>/dev/null &
# the plugin get the fingerprint info from unix socket /var/run/p0f.sock
#
#
#
#   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.

See http://lcamtuf.coredump.cx/p0f.shtml 

=cut

package P0f;

use strict;
use warnings;

use Mail::SpamAssassin::Plugin;
use Mail::SpamAssassin::Logger;
use Convert::Binary::C qw( );
use IO::Socket;
use Net::IP qw( );
use Time::HiRes qw( );
use bytes;

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

use constant QUERY_MAGIC       => 0x0defaced;
use constant QTYPE_FINGERPRINT => 1;
use constant QUERY_ID          => 0x12345678;
use constant SOCKET_FILE       => '/var/run/p0f.sock';
use constant SRC_PORT          => 0;


#my $p0f_regexp = qr{^FreeBSD\b};

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_socket string           (default: /var/run/p0f.sock)

Which socket file p0f is caching

=cut

=for nobody
    push(
        @cmds,
        {
            setting => 'p0f_socket',
            default => '/var/run/p0f.sock',
            type    => $Mail::SpamAssassin::Conf::CONF_TYPE_STRING
        }
    );
=cut

=item mx_host           (default: 127.0.0.1)

Which MX host that p0f runs at.

=cut

    push(
        @cmds,
        {
            setting => 'mx_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->{mx_host} = $1;
              }
        }
    );

=item mx_port n           (default: 25)

Which port mx_host listen.

=cut

    push(
        @cmds,
        {
            setting => 'mx_port',
            default => '25',
            code    => sub {
                my ( $self, $key, $value, $line ) = @_;
                if ( $value !~ m{^(\d+)$} ) {
                    return $Mail::SpamAssassin::Conf::INVALID_VALUE;
                }
                $self->{mx_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 (scalar(@{$msg->{metadata}->{relays_untrusted}}) > 0 ) {
  
        my ($cl_ip) = $msg->{metadata}->{relays_untrusted}->[0]->{ip};

        my ($mx_host)     = $self->{main}->{conf}->{mx_host};
        my ($mx_port)     = $self->{main}->{conf}->{mx_port};
        my ($p0f_timeout) = $self->{main}->{conf}->{p0f_timeout};

        #     my ($p0f_socket) = $self->{main}->{conf}->{p0f_socket};

        if (   defined($mx_host)
            && defined($mx_port)
            && $cl_ip ne ''
            && $cl_ip ne '0.0.0.0'
            && $cl_ip ne '::' )
        {
            my $os_fingerprint_obj =
              $self->_p0f_init( $pms, $p0f_timeout, $mx_host, $mx_port,
                $cl_ip );
            if ( defined($os_fingerprint_obj) ) {
                my $os_fingerprint =
                  $self->_p0f_collect_response( $pms, $os_fingerprint_obj );

                my $info = $os_fingerprint->{genre} 
                           . $os_fingerprint->{detail}
                           . $os_fingerprint->{dist};

                $msg->put_metadata("X-P0f-OS-Fingerprint", $info);
                dbg("metadata: X-P0f-OS-Fingerprint: $info");
  
                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 UNIX socket and sends a query with SMTP client IP address
# information to p0f, which is keeping a cache of
# gathered intelligence on recent incoming TCP connections to our MTA.
sub _p0f_init() {
    my ( $self, $pms, $timeout, $mx_host, $mx_port, $cl_ip ) = @_;
    dbg( "p0f: query: %s port=%s %s", $mx_host, $mx_port, $cl_ip );

    # Convert the IPs and pack the request message
    my $src_ip = Net::IP->new($cl_ip)   or die( Net::IP::Error() );
    my $dst_ip = Net::IP->new($mx_host) or die( Net::IP::Error() );

  #print "src ip:", ( $src->hexip() ), "\n", "dst ip:", ( $dst->hexip() ), "\n";

    my $query = pack( "L L L N N S S",
        QUERY_MAGIC, QTYPE_FINGERPRINT, QUERY_ID, $src_ip->intip(),
        $dst_ip->intip(), SRC_PORT, $mx_port );

    # Open the connection to p0f
    my $sock = IO::Socket::UNIX->new(
        Peer => SOCKET_FILE,
        Type => SOCK_STREAM,
      )
      or die "Could not create socket: $!\n";

    {
        sock       => $sock,
        wait_until => ( Time::HiRes::time + $timeout ),
        query      => $query,
    };
}

# Collect a response from UNIX socket which provides best guess about
# remote host operating system, based on passive OS fingerprinting (p0f);
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};

    # Ask p0f
    syswrite $sock, $obj->{query};
    my $response = <$sock>;    # yuck!
    close $sock;

    #print "response:\n", hexdump( data => $response, );

    # 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 );
    dbg("p0f: Bad response magic.")        if $magic != QUERY_MAGIC;
    dbg("p0f: P0f did not honor our query.") if $type == QTYPE_FINGERPRINT;
    dbg("p0f: This connection is not (no longer?) in the cache.") if $type == 2;

    {
        genre  => $genre,
        detail => $detail,
        dist   => $dist,
        link   => $link,
        fw     => $fw,
        nat    => $nat,
        uptime => $uptime,
    };

}

1;