gistfile1.txt

use strict;
use warnings;
use Fcntl;
use Mojo::File qw(path);
use Mojo::Util qw(getopt);
use Socket qw(SOCK_RAW);
use Socket::Packet qw(
   PF_PACKET
   ETH_P_ALL
   pack_sockaddr_ll unpack_sockaddr_ll recv_len
);

my $ifindex;
getopt
  'i|interface=s' => sub { $ifindex = ifindex(pop) };

my $int = 0;
$SIG{INT} => sub { $int = 1 };

socket my $sock, PF_PACKET, SOCK_RAW, 0 or die "Cannot socket() - $!\n";
bind $sock, pack_sockaddr_ll(ETH_P_ALL, $ifindex, 0, 0, '') or die "Cannot bind() - $!\n";
my $flags = fcntl $sock, F_GETFL, 0 or die "can't getfl(): $!\n";
$flags = fcntl $sock, F_SETFL, $flags | O_NONBLOCK or die "can't setfl(): $!\n";
if (@ARGV) {
  my $dst = pack 'H*', shift;
  my $c = shift;
  send_server_packet($sock, $ifindex, $dst, pack('H*', $c));
  while (!$int) {
    my $packet = get_server_packet($sock) or next;
    sleep 1;
    $c = 1 + unpack 'H*', payload($packet);
    send_server_packet($sock, $ifindex, src_mac($packet), pack('H*', $c));
  }
}
else {
  while (!$int) {
    my $packet = get_client_packet($sock) or next;
    sleep 1;
    $c = 1 + unpack 'H*', payload($packet);
    send_client_packet($sock, $ifindex, x, pack('H*', $c));
  }
}

sub send_client_packet {
  my $packet = send_packet(shift, shift, shift, "\x61" x 10, @_);
  printf STDERR "Sent to client: %s\n", unpack 'H*', $packet;
  return $packet;
}
sub send_server_packet {
  my $packet = send_packet(shift, shift, shift, "\x62" x 10, @_);
  printf STDERR "Sent to server: %s\n", unpack 'H*', $packet;
  return $packet;
}
sub send_packet {
  my ($sock, $ifindex, $dst, $term) = (shift, shift, shift);
  my $packet = pack 'H*', join '', $dst, @_;
  my $addr = pack_sockaddr_ll(ETH_P_ALL, $ifindex, 0, 0, pack('H*', $dst))
  my $len = send $sock, $packet, undef, $addr;
  return $packet;
}

sub get_client_packet {
  my $packet = get_packet(shift, "\x61" x 10);
  printf STDERR "Received from client: %s\n", unpack 'H*', $packet;
  return $packet;
}
sub get_server_packet {
  my $packet = get_packet(shift, "\x62" x 10);
  printf STDERR "Received from server: %s\n", unpack 'H*', $packet;
  return $packet;
}
sub get_packet {
  my ($sock, $term) = @_;
  my $term_len = length($term);
  my $packet;
  local $@ = undef;
  my ($addr, $len);
  eval { ($addr, $len) = recv_len $sock, $packet, 8192, 0 };
  warn $@ if $@;
  return unless $packet;
  return unless substr($packet, $term*-1, $term) eq $term;
  return $packet;
}

sub dst_mac { substr(shift, 0, 6) }
sub src_mac { substr(shift, 6, 6) }
sub pay_len { substr(shift, 12, 2) }
sub payload { substr(shift, 14) }

sub ifindex {
  my $iface = shift;
  my $ifindex = path("/sys/class/net/$iface/ifindex")->slurp;
  return pack 'H*', $ifindex;
}
sub address {
  my $iface = shift;
  my $address = path("/sys/class/net/$iface/address")->slurp;
  return pack 'H*', $address;
}