#!/usr/bin/perl

=head1 NAME

pfarp_remote - listen to network interface for ARP traffic

=head1 SYNOPSIS

pfarp_remote -i <interface> [options]

  Options:
    -d  Daemonize
    -h  Help

=cut

use Getopt::Std;
use File::Basename;
use FileHandle;
use POSIX qw(:signal_h);
use SOAP::Lite;
use Sys::Syslog;
use Config::IniFiles;
use Pod::Usage;
use strict;
use warnings;
use Net::Pcap 0.16;
use Cache::Memcached::libmemcached;

POSIX::sigaction(&POSIX::SIGHUP,
  POSIX::SigAction->new(
                        'restart_handler',
                        POSIX::SigSet->new(),
                        &POSIX::SA_NODEFER
                       )
) or die "pfarp_remote: could not set SIGHUP handler: $!\n";

POSIX::sigaction(&POSIX::SIGTERM,
  POSIX::SigAction->new(
                        'normal_sighandler',
                        POSIX::SigSet->new(),
                        &POSIX::SA_NODEFER
                       )
) or die "pfarp_remote: could not set SIGTERM handler: $!\n";

POSIX::sigaction(&POSIX::SIGINT,
  POSIX::SigAction->new(
                        'normal_sighandler',
                        POSIX::SigSet->new(),
                        &POSIX::SA_NODEFER
                       )
) or die "pfarp_remote: could not set SIGINT handler: $!\n";


my $install_dir = '/usr/local/pf';

my @ORIG_ARGV = @ARGV;
my %args;
getopts('dhvi:', \%args);

pod2usage( -verbose => 1 ) if ($args{h} || !$args{i});

my $daemonize = $args{d};
my $interface = $args{i};
my $script    = File::Basename::basename($0);

#Prevent error from LWP : ensure it connects to servers that have a valid certificate matching the expected hostname
$ENV{PERL_LWP_SSL_VERIFY_HOSTNAME}=0;

my ($dstmac, $srcmac, $srcip, $dstip);

daemonize() if ($daemonize);

openlog("pfarp_remote",'','auth');
syslog("info", "initialized");

my $cfg = new Config::IniFiles( -file => "$install_dir/conf/pfarp_remote.conf");
my $ADMIN_USER = $cfg->val('server','user');
my $ADMIN_PWD = $cfg->val('server','password');
my $PF_HOST = $cfg->val('server','host');

my $MEMCACHED_SERVER = $cfg->val('memcached','host');

syslog("info",$MEMCACHED_SERVER);


arp_detector($interface);

END {
  deletepid();
  syslog("info", "stopping pfarp_remote");
}

exit(0);


=item arp_detector

Listens to ARP traffic and logs.

In PacketFence 3.0 we dropped support for ARP mode. This method has been
severely crippled as part of that work. However it has been kept around since
we might introduce ARP surveillance in the future.

=cut
sub arp_detector {
    my ($eth) = @_;

    my ( $filter_t, $net, $mask, $opt, $err );
    $opt = 1;
    my $filter = "arp";

    my $pcap_t = Net::Pcap::pcap_open_live( $eth, 1500, 1, 0, \$err );
    #my $filter = arp_filter();
    if ( ( Net::Pcap::lookupnet( $eth, \$net, \$mask, \$err ) ) == -1 ) {
        syslog("warning","Net::Pcap::lookupnet failed. Error was $err");
    }
    if ( ( Net::Pcap::compile( $pcap_t, \$filter_t, $filter, $opt, $net ) )
        == -1 )
    {
         syslog("warning","Unable to compile filter string '$filter'");
    }
    Net::Pcap::setfilter( $pcap_t, $filter_t );
    Net::Pcap::loop( $pcap_t, -1, \&process_packet, $eth );
}

sub process_packet {
    my ( $user_data, $header, $packet ) = @_;
    listen_arp($packet) if ($packet);
}

=item listen_arp

Listens to ARP traffic and logs.

In PacketFence 3.0 we dropped support for ARP mode.
This method has been severely crippled as part of that work.
However it has been kept around since we might introduce ARP surveillance in the future.

=cut
sub listen_arp {
    my ( $type, $srcmac, $srcip, $destmac, $destip ) = &decode(@_);
    if ( $type == 2 ) {

        soap_send(clean_mac($srcmac),$srcip);
        #syslog("warning","ARP $srcip is-at $srcmac $srcmac $srcip $destmac $destip");
    }
}

=item decode

Encapsulate the ARP packet decoding.

=cut
sub decode {
    my $pkt = shift;

    my ($m1, $m2, $proto, $hwas, $pas, $hwal, $pal, $opcode, $sha, $spa, $tha, $tpa)
        = unpack( 'H12H12nnnCCnH12NH12N', $pkt );

    return ($opcode, clean_mac($sha), int2ip($spa), clean_mac($tha), int2ip($tpa));
}

=item clean_mac

Clean a MAC address accepting xxxxxxxxxxxx, xx-xx-xx-xx-xx-xx, xx:xx:xx:xx:xx:xx, xxxx-xxxx-xxxx and xxxx.xxxx.xxxx.

Returns an untainted string with MAC in format: xx:xx:xx:xx:xx:xx

=cut
sub clean_mac {
    my ($mac) = @_;
    return (0) if ( !$mac );

    # trim garbage
    $mac =~ s/[\s\-\.:]//g;
    # lowercase
    $mac = lc($mac);
    # inject :
    $mac =~ s/([a-f0-9]{2})(?!$)/$1:/g if ( $mac =~ /^[a-f0-9]{12}$/i );
    # Untaint MAC (see perldoc perlsec if you don't know what Taint mode is)
    if ($mac =~ /^([0-9a-zA-Z]{2}:[0-9a-zA-Z]{2}:[0-9a-zA-Z]{2}:[0-9a-zA-Z]{2}:[0-9a-zA-Z]{2}:[0-9a-zA-Z]{2})$/) {
        return $1;
    }

    return;
}


sub int2ip {
    return ( join( ".", unpack( "C4", pack( "N", shift ) ) ) );
}

sub soap_send {
  my ($srcmac,$srcip) =@_;
  my $in_mem = check_memcached($srcmac,$srcip);
  if ($in_mem) {
      eval {
        my $soap = new SOAP::Lite(
          uri => 'http://www.packetfence.org/PFAPI',
          proxy => 'https://' . $ADMIN_USER . ':' . $ADMIN_PWD . '@' . $PF_HOST
        );
        my %data = (
            'mac' => $srcmac,
            'ip' => $srcip,
        );

        my $result = $soap->update_ip4log(%data);
        if ($result->fault) {
          syslog("warning", "arp could not be added");
        } else {
          syslog("info", "added arp $srcmac to $srcip");
        }
      };
      if ($@) {
        syslog("warning", "connection to $PF_HOST with username $ADMIN_USER was NOT successful: $@");
        #next;
      }
  }
}


=item check_memcached

check if the couple mac and ip already exist in memcached

=cut

sub check_memcached {
    my ($mac, $ip) = @_;
    my $value = get_memcached($mac,$MEMCACHED_SERVER);
    if (defined($value) && $value ne '') {
        if ($value ne $ip) {
            set_memcached($mac,$ip,undef,$MEMCACHED_SERVER);
            #syslog("info", "added $mac to $ip in memcached");
            return (1);
        } else {
            return (0);
        }
    } else {
        my $retour = set_memcached($mac,$ip,undef,$MEMCACHED_SERVER);
        #syslog("info", "added $mac to $ip in memcached");
        return (1);
    }

}


=item get_memcached

get information stored in memcached

=cut
sub get_memcached {
    my ( $key, $mc ) = @_;
    my $memd;
    $memd = Cache::Memcached::libmemcached->new(
        servers => [$mc],
        debug => 0,
        compress_threshold => 10_000,
    ) unless defined $memd;
    return $memd->get($key);
}

=item set_memcached

set information into memcached

=cut
sub set_memcached {
    my ( $key, $value, $exptime, $mc ) = @_;
    my $memd;
    $memd = Cache::Memcached::libmemcached->new(
        servers => [$mc],
        debug => 0,
        compress_threshold => 10_000,
    ) unless defined $memd;

    #limit expiration time to 6000
    $exptime = $exptime || 6_000;
    if ( $exptime > 6_000 ) {
        $exptime = 6_000;
    }

    return $memd->set( $key, $value, $exptime );
}

sub daemonize {
  chdir '/'               or die "Can't chdir to /: $!";
  open STDIN, '<', '/dev/null' or die "Can't read /dev/null: $!";
  open STDOUT, '>', '/dev/null' or die "Can't write to /dev/null: $!";

  defined(my $pid = fork) or die "pfarp_remote: could not fork: $!";
  POSIX::_exit(0) if ($pid);
  if (!POSIX::setsid()) {
    syslog("warning", "could not start a new session: $!");
  }
  open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
  createpid();
  return 1;
}

sub normal_sighandler {
  deletepid();
  syslog("info", "caught SIG".$_[0]." - terminating pfdetect_remote");
  die("pfarp_remote: caught SIG".$_[0]." - terminating\n");
}

sub restart_handler {
  deletepid();
  syslog("info", "caught SIG".$_[0]." - restarting pfarp_remote");
  if (!exec($0, @ORIG_ARGV)) {
    syslog("warning", "could not restart: #!");
    die "pfarp_remote: could not restart: $!\n";
  }
}


sub createpid {
  my $pname = basename($0);
  my $pid = $$;
  my $pidfile = $install_dir."/var/run/$pname.pid";
  syslog("info", "$pname starting and writing $pid to $pidfile");
  my $outfile = new FileHandle ">$pidfile";
  if (defined($outfile)) {
    print $outfile $pid;
    $outfile->close;
    return($pid);
  } else {
    syslog("warning", "$pname: unable to open $pidfile for writing: $!");
    return(-1);
  }
}

sub deletepid {
  my ($pname) = @_;
  $pname = basename($0) if (!$pname);
  my $pidfile = $install_dir."/var/run/$pname.pid";
  unlink($pidfile) || return(-1);
  return(1);
}

=head1 AUTHOR

Inverse inc. <info@inverse.ca>

=head1 COPYRIGHT

Copyright (C) 2005-2019 Inverse inc.

=head1 LICENSE

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.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301,
USA.

=cut

# vim: set shiftwidth=4:
# vim: set expandtab:
# vim: set backspace=indent,eol,start:
