use Data::Dumper;
use IO::Socket::INET;
use IO::Select;
use Getopt::Std;
use Net::Pcap;



sub build_packet
{
    my $mode = shift; # 01 fuer lesen 03 fuer setzen
    my $mymac = shift;
    my $swmac = shift;
    my $cmdno = shift;
    my $command = shift;
    my $args = shift;
    my $cred = shift;


    my $packet = pack("C", 1);
    $packet .= pack("C", $mode); # Modus
    $packet .= pack("CCCCCC",0,0,0,0,0,0); #fuell nullen
    $packet .= pack_mac_address($mymac);
    $packet .= pack_mac_address($swmac);
    $packet .= pack("N", $cmdno);
    $packet .= "NSDP";
    $packet .= pack("L", 0); # fuell nullen
    if($cred)
    {
	my $masterpw = "NtgrSmartSwitchRock";
	My $enccred = $cred ^ substr($masterpw, 0, length($cred));
	$packet .= pack("n", 0xa);
	$packet .= pack("n", length($cred));
	$packet .= $enccred;
    }
    if($command > 0) # sonst nur leeres login
    {
	$packet .= pack("n", $command);
	$packet .= $args;
    }
    else
    {
	$packet .= pack("N", 0xffff0000);
    }
    return($packet);
}

sub pack_mac_address
{
    my $macaddress = shift; # im format 11:22:33:44:55:66
    my $mac;
    my @octets = split(/:/, $macaddress);
    foreach my $oc (@octets)
    {
	$mac .= pack("H*", $oc);
    }
    return($mac);
}

sub parse_packet
{
    my $packet = shift;

    my $result = {};

    $result->{'mode'} = unpack("n", $packet);
    $packet = substr($packet, 8); # da sind ja noch 4 nullen
    my @macs = unpack("CCCCCC", $packet);
    foreach my $mac (@macs)
    {
	$result->{'guimac'} .= sprintf("%x:", $mac);
    }
    chop($result->{'guimac'}); # der letzte :
    $packet = substr($packet, 6);
    my @macs = unpack("CCCCCC", $packet);
    foreach my $mac (@macs)
    {
	$result->{'swmac'} .= sprintf("%x:", $mac);
    }
    chop($result->{'swmac'}); # der letzte :
    $packet = substr($packet, 6);
    $packet = substr($packet, 2); # man koennte cmdno auch als long auspacken
    $result->{'cmdno'} = unpack("n", $packet);
    $packet = substr($packet, 2);
    $packet = substr($packet, 4); # NSDP
    $packet = substr($packet, 4); # 4 nullen
    $result->{'cmd'} = unpack("n", $packet);
    $packet = substr($packet, 2);
    if($result->{'cmd'} == 1) # discover antwort
    {
	my $typelen = unpack("n", $packet);
	$packet = substr($packet, 2);
	$result->{'type'} = substr($packet, 0, $typelen);
	$packet = substr($packet, $typelen);
	# option 02 wissen wir noch nicht
	$packet = substr($packet, 6);
	# option 03 wissen wir auch nicht nur dass sie nen laengenfeld hat
	my $nextval = unpack("n", $packet);
	$packet = substr($packet, 2);
	if($nextval == 3) #so sollte es wohl sein
	{
	    my $len = unpack("n", $packet);
	    $packet = substr($packet, 2);
	    # was jetzt in $len paketen drin stehe wissen wir nicht drueberspringen
	    $result->{'hostname'} = substr($packet,0, $len);
	    $packet = substr($packet, $len);
	}
	else # erstmal katastrophenfehler bis wir mal so ein paket sehen
	{
	    die "Error in parsing discovery answer for 3 nextval was $nextval";
	}
	$nextval = unpack("n", $packet);
	$packet = substr($packet, 2);
	if($nextval == 4) # die macadresse des switches
	{
	    my $len = unpack("n", $packet);
	    $packet = substr($packet, 2);
	    $result->{'swmac'} = substr($packet, 0, 6) unless $result->{'swmac'};
	    $packet = substr($packet, 6);
	}
	else # erstmal katastrophenfehler bis wir mal so ein paket sehen
	{
	    die "Error in parsing discovery answer for 4 nextval was $nextval";
	}
	$nextval = unpack("n", $packet);
	$packet = substr($packet, 2);
	if($nextval == 5) # noch ein unbekannter langer
	{
	    my $len = unpack("n", $packet);
	    $packet = substr($packet, 2);
	    # was jetzt in $len paketen drin stehe wissen wir nicht drueberspringen
	    $packet = substr($packet, $len);
	}
	else # erstmal katastrophenfehler bis wir mal so ein paket sehen
	{
	    die "Error in parsing discovery answer for 5 nextval was $nextval";
	}
	$nextval = unpack("n", $packet);
	$packet = substr($packet, 2);
	if($nextval == 6) # IP
	{
	    my $len = unpack("n", $packet);
	    $packet = substr($packet, 2);
	    $result->{"ip"} = inet_ntoa(substr($packet, 0, 4));
	    $packet = substr($packet, 4);
	}
	else # erstmal katastrophenfehler bis wir mal so ein paket sehen
	{
	    die "Error in parsing discovery answer for 6 nextval was $nextval";
	}
	$nextval = unpack("n", $packet);
	$packet = substr($packet, 2);
	if($nextval == 7) # netmask
	{
	    my $len = unpack("n", $packet);
	    $packet = substr($packet, 2);
	    $result->{"netmask"} =  inet_ntoa(substr($packet, 0, 4));
	    $packet = substr($packet, 4);
	}
	else # erstmal katastrophenfehler bis wir mal so ein paket sehen
	{
	    die "Error in parsing discovery answer for 7 nextval was $nextval";
	}
	$nextval = unpack("n", $packet);
	$packet = substr($packet, 2);
	if($nextval == 8) # netmask
	{
	    my $len = unpack("n", $packet);
	    $packet = substr($packet, 2);
	    $result->{"router"} =  inet_ntoa(substr($packet, 0, 4));
	    $packet = substr($packet, 4);
	}
	else # erstmal katastrophenfehler bis wir mal so ein paket sehen
	{
	    die "Error in parsing discovery answer for 8 nextval was $nextval";
	}
	$nextval = unpack("n", $packet);
	$packet = substr($packet, 2);
	if($nextval == 11) # laenge und ein short
	{
	    my $len = unpack("n", $packet);
	    $packet = substr($packet, 2);
	    my $unknown;
	    if($len == 1)
	    {
		$unknown = unpack("C", $packet);
		$packet = substr($packet, 1)
	    }
	    elsif($len == 2)
	    {
		$unknown = unpack("n", $packet);
		$packet = substr($packet, 2);
	    }
	}
	else # erstmal katastrophenfehler bis wir mal so ein paket sehen
	{
	    die "Error in parsing discovery answer for 11 nextval was $nextval";
	}
	$nextval = unpack("n", $packet);
	$packet = substr($packet, 2);
	if($nextval == 12) # laenge und ein byte
	{
	    my $len = unpack("n", $packet);
	    $packet = substr($packet, 2);
	    my $unknown = unpack("C", $packet);
	    $packet = substr($packet, 1);
	}
	else # erstmal katastrophenfehler bis wir mal so ein paket sehen
	{
	    print Dumper $result;
	    die "Error in parsing discovery answer for 12 nextval was $nextval";
	}
	$nextval = unpack("n", $packet);
	$packet = substr($packet, 2);
	if($nextval == 13) # Laenge und Version
	{
	    my $len = unpack("n", $packet);
	    $packet = substr($packet, 2);
	    $result->{'version'} = substr($packet, 0, $len);
	    $packet = substr($packet, $len);
	}
	else # erstmal katastrophenfehler bis wir mal so ein paket sehen
	{
	    die "Error in parsing discovery answer for 13 nextval was $nextval";
	}
	$nextval = unpack("n", $packet);
	$packet = substr($packet, 2);
	if($nextval == 14) # ein Long Laenge und unbekannt
	{
	    my $len = unpack("N", $packet);
	    $packet = substr($packet, 4);
	    my $unknown = substr($packet, 0, $len);
	    $packet = substr($packet, $len);
	}
	else # erstmal katastrophenfehler bis wir mal so ein paket sehen
	{
	    die "Error in parsing discovery answer for 13 nextval was $nextval";
	}
    }
    if($result->{'cmd'} == 0xa) #login
    {
	my $len = unpack("n", $packet);
	$packet = substr($packet, 2);
	$result->{'pw'} = substr($packet, 0, $len);
	$packet = substr($packet, $len);
	my $nextval = unpack("N", $packet);
	if($nextval != 0xffff0000) # kommt noch ein kommando
	{
	    $result->{'cmd'} = $nextval;
	}
    }
    if($result->{'cmd'} == 0x2800) # vlan
    {

    }
    if($result->{'cmd'} == 0x6000) # port count
    {
	my $len = unpack("n", $packet);
	$packet = substr($packet, 2);
	$result->{'portcount'} = unpack("C", $packet);
	$packet = substr($packet, $len);
    }
    if($result->{'cmd'} == 0xc00) #port status
    {
	my $done;
	my %stati = ( 5 => '1000mbit', 4 => '100mbit', 1 => '10mbit', 0 => 'no link');
	while(!$done)
	{
	    my $len = unpack("n", $packet);
	    $packet = substr($packet, 2); # 3 byte
	    my $entry = {};
	    ($entry->{'index'}, $entry->{'mbit'}, $entry->{'status2'}) = unpack("CCC", $packet);
	    $entry->{'mbit'} = $stati{$entry->{'mbit'}};
	    $packet = substr($packet, $len);
	    my $next = unpack("n", $packet);
	    push(@{$result->{'ports'}}, $entry);
	    $done = ($next != 0xc00); # noch ein port
	    $packet = substr($packet, 2);
	}
    }
    if($result->{'cmd'} == 0x7400) # port whatever
    {
	my $len = unpack("n", $packet);
	$packet = substr($packet, 2);
	@{$result->{'unknown'}} = unpack("C*", $packet);
	$packet = substr($packet, $len);
    }
    if($result->{'cmd'} == 0x5c00) # mirroring
    {
	my $len = unpack("n", $packet);
	$packet = substr($packet, 2);
	if($len == 3) # status
	{
	    $result->{'destination'} = unpack("C", $packet);
	    $packet = substr($packet, 1);
	    my $bits = unpack("B*", substr($packet,0,2));
	    my $j=1;
	    for(my $i = length($bits) - 5 ; $i < length($bits); $i++) # das geht bestimmt auch in einer zeile
	    {
		push(@{$result->{'mirrorsources'}}, $j) if(substr($bits, $i, 1) > 0);
		$j++;
	    }
	}
	else
	{
	    $result->{"mirrorstatus"} = "ok";
	}
    }
    if($result->{'cmd'} == 0x2800) # VLANs auflisten/anlegen
    {
        my $done;
	while(!$done)
	{
	    my $len = unpack("n", $packet);
	    $packet = substr($packet, 2);
	    my $vlan = unpack("n", $packet);
	    $packet = substr($packet, 2);
	    my $memberports = unpack("B[5]", $packet);
	    $packet = substr($packet, 1);
	    my $taggedports = unpack("B[5]", $packet);
	    $packet = substr($packet, 1);
	    my $members = [];
	    my @memberports = split("", $memberports);
	    my @taggedports = split("", $taggedports);
	    for(my $i=0; $i < 8; $i++)
	    {
		if($memberports[$i] > 0)
		{
		    push(@$members, ($i+1));
		    if($taggedports[$i] > 0)
		    {
			$members->[$#{$members}] .= "T";
		    }
		}
	    }
	    my $vlanentry->{'id'} = $vlan;
	    $vlanentry->{'members'} = $members;
	    push(@{$result->{'vlans'}}, $vlanentry);
	    my $next = unpack("n", $packet);
	    $done = ($next != 0x2800);
	    $packet = substr($packet, 2);
	}
    }
    return($result);
}

sub create_discover
{
    my $mymac = shift;
    my $swmac = shift;
    my $cmdno = shift;

    my $packet = build_packet(1,$mymac, $swmac, $cmdno, 01, pack("NNNNNNNNNNNNN",2,3,4,5,6,7,8,0xb,0xc,0xd,0xe,0xf,0x7400).pack("N",0xffff).pack("S",0));
    return($packet);
}

sub create_login
{
    my $mymac = shift;
    my $swmac = shift;
    my $cmdno = shift;
    my $login = shift;

    my $packet = build_packet(3,$mymac, $swmac, $cmdno, -1, "", $login);
    return($packet);
}

sub create_simplequery
{
    my $mymac = shift;
    my $swmac = shift;
    my $cmdno = shift;
    my $query = shift;

    my $packet = build_packet(1,$mymac, $swmac, $cmdno, $query, pack("Nn", 0xffff, 0));
    return($packet);
}

sub create_mirror
{
    my $mymac = shift;
    my $swmac = shift;
    my $cmdno = shift;
    my $login = shift;
    my $destination = shift;
    my @sources = shift;
    my $packet;

    if($login)
    {
	$packet = create_login($mymac, $swmac, $cmdno, $login);
	# die letzten vier byte muessen ab
	$packet = substr($packet, 0, -4);
	$packet .= pack("n", 0x5c00);
    }
    else
    {
	$packet = create_simplequery($mymac, $swmac, $opt_q, 0x5c00);
    }
    if(defined($destination))
    {
	$packet.= pack("n", 3); #laenge der daten
	$packet.= pack("C", $destination);
	my $sourcebyte = 0;
	foreach my $source (@sources)
	{
	    $sourcebyte += 2**(8 - $source);
	}
	$packet .= pack("C", 0);
	$packet .= pack("C", $sourcebyte);
	$packet .= pack("N", 0xffff0000);
    }
    return($packet);
}

sub create_vlan
{
    my $mymac = shift;
    my $swmac = shift;
    my $cmdno = shift;
    my $login = shift;
    my $vlanid = shift;
    my $memberports = shift;
    my $taggedports = shift;
    
    my $packet = create_login($mymac, $swmac, $cmdno, $login);
    $packet = substr($packet, 0, -4);
    $packet .= pack("n", 0x2800);
    $packet .= pack("n", 4);
    $packet .= pack("n", $vlanid);
    $packet .= pack("B[8]", $memberports."000");# die zwei hier gehen nciht, wenn wir nen switch mit > 5 ports haben, aber mehr als 8 geht eh nicht sonst stimmt das protokoll nicht
    $packet .= pack("B[8]", $taggedports."000");
    $packet .= pack("N", 0xffff0000);
    return($packet); # vermutlich koennte man auch einfach mehrere hintereinander schicken
}

sub usage
{
    print "netgear.pl -s sourcemac -d destmac (not for discover) -q commandindex -a ownipaddress -n netmask of interface where this is used\n
            <-D> discover switches in the lan (currently finds only the first to answer
            <-L> login only -l password
            <-C> get portcount
            <-S> get portstatus
            <-M s:sourceport,sourceport..:destinationport -l password> Mirrors sourceport(s) to destinationport
                                                                      -M something without -l  shows the status 
                                                                      -M s:0:0 -l password disables the mirror
            <-V> shows the vlan status
            <-v vlanid,port,port -l password> creates vlan id and adds the ports given. Add a 'T' to add this as
                                              a tagged port for trunks. -v -vlanid (negativ) removes the vlan\n";
    exit(0);
}

# D discover L login only l<login> q<cmdno> C portcount S portstatus T unknown test M <s:quelle,quelle-d:zielport> -V zum anzeigen -v <vlanid,port,port<t> fuer tagged> setzen port -vlanid loeschen
getopts("DLCSTl:q:M:Vv:s:d:a:n:h");

my $filter;

($opt_s & $opt_a & $opt_n) || usage();
if(!$opt_D)
{
    $opt_d || usage();
}
$opt_h && usage;

my $err;
my $pcap = Net::Pcap::open_live("lan0", 1500, 0, 5000, \$err);
Net::Pcap::compile($pcap, \$filter, "port 63322 and not host $opt_a", 1, "$opt_n"); # netzmaske am schluss muss noch dynamisch
Net::Pcap::setfilter($pcap, $filter);

if($opt_D) # discover
{
#    my $packet = create_discover($opt_s, "00:00:00:00:00:00", $opt_q);
    $opt_d = "00:00:00:00:00:00" if !$opt_d;
    my $packet = create_discover($opt_s, $opt_d, $opt_q);
    my $sendsock   = IO::Socket::INET->new(PeerAddr => '255.255.255.255', Proto => 'udp', PeerPort => 63322, LocalPort => 63321, Broadcast => 1) || die "Could not create send_socket reason $!";
    $sendsock->send($packet) || die "Error sending discovery reason $!";
    my $packet;
    my %header;
    my $ret = Net::Pcap::next_ex($pcap, \%header, \$packet);
    $packet = substr($packet, 42); #ethernet/ip/udp
    if($ret == 1)
    {
        my $result = parse_packet($packet);
    	foreach my $key (qw(type hostname version swmac ip netmask router cmdno))
    	{
	    print "$key: $result->{$key}\n";
    	}
    }
}
if($opt_L)
{
    usage() unless $opt_l;
    my $packet = create_login($opt_s, $opt_d, $opt_q, $opt_l);
    my $sendsock   = IO::Socket::INET->new(PeerAddr => '255.255.255.255', Proto => 'udp', PeerPort => 63322, LocalPort => 63321, Broadcast => 1) || die "Could not create send_socket reason $!";
    $sendsock->send($packet) || die "Error sending Login reason $!";
    my %header;
    my $ret = Net::Pcap::next_ex($pcap, \%header, \$packet);
    if($ret > 0)
    {
	$packet = substr($packet, 42); #ethernet/ip/udp
	
	my $result = parse_packet($packet);
	if($result->{'pw'} eq $opt_l)
	{
	    print "Login OK\n";
	}
	else
	{
	    print "Login failed\n";
	}
    }
    else
    {
	print "No answer\n;"
    }
}
if($opt_C)
{
    my $packet = create_simplequery($opt_s, $opt_d, $opt_q, 0x6000);
    my $sendsock   = IO::Socket::INET->new(PeerAddr => '255.255.255.255', Proto => 'udp', PeerPort => 63322, LocalPort => 63321, Broadcast => 1) || die "Could not create send_socket reason $!";
    $sendsock->send($packet) || die "Error sending discovery reason $!";
    my %header;
    my $ret = Net::Pcap::next_ex($pcap, \%header, \$packet);
    $packet = substr($packet, 42); #ethernet/ip/udp

    my $result = parse_packet($packet);
    print "$result->{'portcount'} ports\n";
}
if($opt_S)
{
    my $packet = create_simplequery($opt_s, $opt_d, $opt_q, 0xc00);
    my $sendsock   = IO::Socket::INET->new(PeerAddr => '255.255.255.255', Proto => 'udp', PeerPort => 63322, LocalPort => 63321, Broadcast => 1) || die "Could not create send_socket reason $!";
    $sendsock->send($packet) || die "Error sending portcount query reason $!";
    my %header;
    my $ret = Net::Pcap::next_ex($pcap, \%header, \$packet);
    if($ret > 0)
    {
    	$packet = substr($packet, 42); #ethernet/ip/udp

    	my $result = parse_packet($packet);
    	my @portstatus = qw(down up);
#    	my @ports = sort {$result->{'ports'}->[$a]->{'index'} cmp $result->{'ports'}->[$b]->{'index'} } @{$result->{'ports'}};
	my $ports = $result->{'ports'};
	@ports = sort {$ports->[$a]->{'index'} cmp $ports->[$b]->{'index'}} @$ports; # genausoschlimm, erst wirklich ein array keine arrayref drausmachen!
    	foreach my $p (@ports)
    	{
	    print "Port $p->{'index'}: $portstatus[$p->{'status2'}]\t$p->{'mbit'}\n";
    	}
    }
}
if($opt_T)
{
    my $packet = create_simplequery($opt_s, $opt_d, $opt_q, 0x7400);
    my $sendsock   = IO::Socket::INET->new(PeerAddr => '255.255.255.255', Proto => 'udp', PeerPort => 63322, LocalPort => 63320, Broadcast => 1) || die "Could not create send_socket reason $!";
    $sendsock->send($packet) || die "Error sending discovery reason $!";
    my %header;
    my $ret = Net::Pcap::next_ex($pcap, \%header, \$packet);
    $packet = substr($packet, 42); #ethernet/ip/udp

    my $result = parse_packet($packet);
    print Dumper($result);
}
if($opt_M)
{
    my $packet;

    if($opt_M !~ /s:([^-]+)-d:(\d+)/) # kein gueltiges argument, nur portabfrage
    {
	$packet = create_mirror($opt_s, $opt_d, $opt_q, $opt_L, 0);
    }
    else
    {
	my @array = split(/,/, $1);
	$packet = create_mirror($opt_s, $opt_d, $opt_q, $opt_l, $2, @array);
    }
    my $sendsock   = IO::Socket::INET->new(PeerAddr => '255.255.255.255', Proto => 'udp', PeerPort => 63322, LocalPort => 63321, Broadcast => 1) || die "Could not create send_socket reason $!";
    $sendsock->send($packet) || die "Error sending mirror reason $!";
    my %header;
    my $ret = Net::Pcap::next_ex($pcap, \%header, \$packet);
    $packet = substr($packet, 42); #ethernet/ip/udp

    my $result = parse_packet($packet);
#    print Dumper($result);
    print "Sources: ";
    foreach my $m (@{$result->{'mirrorsources'}})
    {
	print $m." ";
    }
    print "\nDestination: $result->{'destination'}\n";

}
if($opt_V)
{
    my $packet = create_simplequery($opt_s, $opt_d, $opt_q, 0x2800);
    my $sendsock   = IO::Socket::INET->new(PeerAddr => '255.255.255.255', Proto => 'udp', PeerPort => 63322, LocalPort => 63321, Broadcast => 1) || die "Could not create send_socket reason $!";
    $sendsock->send($packet) || die "Error sending vlan query reason $!";
    my %header;
    my $ret = Net::Pcap::next_ex($pcap, \%header, \$packet);
    $packet = substr($packet, 42); #ethernet/ip/udp
    
    my $result = parse_packet($packet);
#    print Dumper($result);
    foreach my $v (@{$result->{'vlans'}})
    {
	print "VlanID: $v->{'id'} Members: ".join(" ", @{$v->{'members'}})."\n";
    }
}
if($opt_v)
{
    my($vlanid, @ports) = split(/,/, $opt_v);
    my $packet;
    # ports zerlegen und Ts finden
    if($opt_v > 0) # vlan anlegen
    {
	my ($memberports, $taggedports);
	for(my $i = 1; $i < 6; $i++)
	{
	    if(my @p = grep($_ =~ /$i/, @ports))
	    {
		$memberports .= "1";
		if($p[0] =~ /t$/i)
		{
		    $taggedports .= "1";
		}
		else
		{
		    $taggedports .= "0";
		}
	    }
	    else
	    {
		$memberports .= "0";
		$taggedports .= "0";
	    }
	}
	$packet = create_vlan($opt_s, $opt_d, $opt_q, $opt_l, $vlanid, $memberports, $taggedports);
    }
    else # vlan loeschen
    {
	$packet = create_login($opt_s, $opt_d, $opt_q, $opt_l);
	$packet = substr($packet, 0, -4);
	$packet .= pack("n", 0x2c00);
	$packet .= pack("n", 2);
	$packet .= pack("n", $opt_v * -1);
	$packet .= pack("N", 0xffff0000);
    }
    my $sendsock = IO::Socket::INET->new(PeerAddr => '255.255.255.255', Proto => 'udp', PeerPort => 63322, LocalPort => 63321, Broadcast => 1) || die "Could not create send_socket reason $!";
    $sendsock->send($packet) || die "Error sending vlan set reason $!";
    my %header;
    my $ret = Net::Pcap::next_ex($pcap, \%header, \$packet);
    $packet = substr($packet, 42); #ethernet/ip/udp

    my $result = parse_packet($packet);
    print Dumper($result);

}