#!/usr/bin/perl -w

$| = 0;

use strict;
use Net::Pcap qw(:DEFAULT :functions);
use Sys::Syslog;

use constant V8021Q			=> 0x8100;
use constant ETHERTYPE_PPPOEDISC	=> 0x8863;
use constant PPPOE_VER			=> 1;
use constant PPPOE_TYPE			=> 1;
use constant PADO_CODE			=> 7;
use constant PADI_CODE			=> 9;
use constant TAG_END_OF_LIST		=> 0x0000;
use constant TAG_SERVICE_NAME		=> 0x0101;
use constant TAG_AC_NAME		=> 0x0102;
use constant TAG_HOST_UNIQ              => 0x0103;

sub alarmed;
sub callback($$$);
sub err($);
sub ether_aton($);
sub ether_ntoa($);
sub logmsg($$);
sub send_padi_bg(@);
sub usage($);

my $syslog_opened = 0;
my ($bpf, $ec, $err, $listen, $mac, $pcap);

my $timeout = 1;
my $snaplen = 128;
my $syslog_facility = 'local3';
my $uniq = 0;
my $dot1q = 0;

# Start
my ($me, $tag) = ($0, $0);
$tag =~ s,^.*/,,; $tag =~ s/\.pl//;
$0 = "$tag " . join(' ', @ARGV);

my %ignored = ();
my %seen = ();
my $arg;
my $m;
my @sendif = ();

while($#ARGV >= 0) {
  $arg = shift @ARGV;
  if($arg eq '-i')    { push @sendif, shift @ARGV;	}
  elsif($arg eq '-I') { $listen = shift @ARGV;		}
  elsif($arg eq '-f') { $syslog_facility = shift @ARGV;	}
  elsif($arg eq '-m') { $mac = shift @ARGV;		}
  elsif($arg eq '-r') { $uniq = 1;			}
  elsif($arg eq '-s') { $snaplen = shift @ARGV;		}
  elsif($arg eq '-t') { $timeout = shift @ARGV;		}
  elsif($arg eq '-l') {
    $m = shift @ARGV;
    $arg = ether_aton($m);
    err("wrong mac address $m") unless defined $arg;
    $ignored{$arg} = 1;
  }
  else { usage($arg); }
}

usage(undef) if ($#sendif < 0);
$dot1q = 1 if ($#sendif > 0);
$listen = $sendif[0] unless defined $listen;

unless (defined $mac) {
  require IO::Interface::Simple;
  my $nif = IO::Interface::Simple->new($listen);
  err("wrong interface $listen") unless defined $nif;
  $mac = $nif->hwaddr;
  err("cannot obtain hw address of $listen") unless defined $mac;
}

$snaplen = 65535 if $snaplen == 0;
my $bmac = ether_aton($mac);
err("wrong mac address $mac") unless defined $bmac;
send_padi_bg(@sendif);

my $filter = "ether dst $mac and ether proto " . ETHERTYPE_PPPOEDISC;
$filter .= " or (vlan and $filter)";

err("cannot listen interface $listen: $err")
  unless $pcap = pcap_open_live($listen, $snaplen, 0, 1000, \$err);
err("cannot compile filter: $filter")
  if pcap_compile($pcap, \$bpf, $filter, 1, 0) < 0;
pcap_setfilter($pcap, $bpf);

$SIG{ALRM} = \&alarmed;
alarm $timeout;
$ec = 0;
while($ec == 0) {
  $ec = pcap_loop($pcap, -1, \&callback, undef);
}
pcap_close($pcap);
exit(0);

sub callback($$$) {
  my ($code, $i, $id, $len, $tag_type, $tag_length, $tag_value);
  return if $_[1]->{'len'} < 20;	# sanity check: short frame

  my ($dst, $src, $ftype, $ftag, $etype, $fp) = unpack('a6a6na2a2a*' , $_[2]);
  return if exists $ignored{$src};	# ignored PPPoE server

  my $ifname = $listen;
  if ($ftype == V8021Q) {
    $ifname = 'vlan' . (unpack('n', $ftag) & 0x0fff);
  }
  else { $fp = $ftag . $etype . $fp; }
  ($ftag, $code, $id, $len, $fp) = unpack('CCnna*', $fp);
  return if $code != PADO_CODE;		# not PADO

  $src = ether_ntoa($src);
  print "Interface!$ifname!MAC!$src";

  $len = length($fp);
  $i=0;
  my @acname=();
  my @sname=();
  while ($i + 4 < $len) {
    ($tag_type, $tag_length, $tag_value) = unpack('nna*', substr($fp, $i));
    if ($tag_length > length($tag_value)) {
      logmsg('notice', "bad PADI from $src at $ifname");
      print "\n";
      return;
    }

    if ($tag_length > 0) { $tag_value = unpack("a$tag_length", $tag_value) }
    else { $tag_value = ''; }
    if    ($tag_type == TAG_AC_NAME)	  { push @acname, $tag_value; }
    elsif ($tag_type == TAG_SERVICE_NAME) { push @sname, $tag_value; }
    $i += 4 + $tag_length;
  }
  foreach $tag_value (@acname) { print '!AC-Name!' . $tag_value; }
  foreach $tag_value (@sname) { print '!Service-Name!' . $tag_value; }
  print "\n";
}

sub logmsg($$) {
  unless($syslog_opened) {
    openlog($tag, 'cons,perror,pid', $syslog_facility) and $syslog_opened = 1;
  }
  syslog($_[0], $_[1]);
}

sub err($) {
  logmsg('err', $_[0]);
  exit(1);
}

sub alarmed {
  pcap_breakloop($pcap);
}

sub ether_aton($) {
  my $a = shift;

  $a =~ s/[\-\:\.]//g;
  return undef if length($a) != 12;
  return join('', map { pack('C', hex($_)) } ($a =~ m/../g ));
}

sub ether_ntoa($) {
  my $n = $_[0];
  return sprintf "%02x:%02x:%02x:%02x:%02x:%02x",
    vec($n, 0, 8), vec($n, 1, 8), vec($n, 2, 8),
    vec($n, 3, 8), vec($n, 4, 8), vec($n, 5, 8);
}

sub send_padi_bg(@) {
  my ($ec, $pcap, $tags, $tlen, $packet, $interface);

  $SIG{CHLD} = 'IGNORE';
  $ec = fork();
  err("cannot fork: $!") unless defined $ec;
  return if $ec; # parent

  # child
  if ($uniq) { $uniq = int(rand(1<<32)); }
  else { $uniq = $$ & 0xffffffff; }
  $tags =
    # Host-Uniq, its length=4, its contents
    pack('n', TAG_HOST_UNIQ) . pack('n', 4) . pack('N', $uniq) .
    # Service-Name, its length=0
    pack('n', TAG_SERVICE_NAME) . pack('n', 0) .
    # End-of-List, its length=0
    pack('n', TAG_END_OF_LIST) . pack('n', 0);
  $tlen = length($tags);
  $packet =
    # Ethernet header: dst MAC, src MAC, TYPE
    ether_aton('ff:ff:ff:ff:ff:ff') . $bmac . pack('n', ETHERTYPE_PPPOEDISC) .
    # PPPoE PADI: VER, TYPE, CODE, SESSION_ID=0
    pack('C', (PPPOE_VER<<4) + PPPOE_TYPE) . pack('C', PADI_CODE) . pack('n', 0) .
    # LENGTH, tags
    pack('n', $tlen) . $tags;
  # zero padding upto 60 bytes ethernet frame length (without checksum)
  $packet .= pack('a' . (40-$tlen) , '') if $tlen < 40;

  # give parent some time to start listening
  select(undef, undef, undef, 0.01);

  foreach $interface (@_) {
    err("cannot open interface $interface: $err")
      unless $pcap = pcap_open_live($interface, $snaplen, 0, 0, \$err);
    logmsg('err', "could not send PADI: $err") if pcap_sendpacket($pcap, $packet) != 0;
    pcap_close($pcap);
  }
  exit(0);
}

sub usage($) {
  print STDERR "$me: unknown option $_[0]\n" if defined $_[0];
  print STDERR "Usage: $me [-I iface] [-f facility] [-l mac] [-m mac] [-r] [-s snaplen] [-t timeout] -i iface ...\n";
  exit(1);
}