#!/usr/bin/perl
# $RedRiver$
########################################################################
# su.cgi *** a CGI for Trango SU utilities.
# 
# 2007.02.07 #*#*# andrew fresh <andrew@mad-techies.org>
########################################################################
# Copyright (C) 2007 by Andrew Fresh
# 
# This program is free software; you can redistribute it and/or modify 
# it under the same terms as Perl itself.
########################################################################
use strict;
use warnings;

my $host_file = '/conf/wstationinfo/hosts.xml';

my $default_mac  = '0001DE';
my $default_suid = 'all';
my $default_cir  = 256;
my $default_mir  = 9999;
my $Start_SUID = 3;

use CGI qw/:standard/;
use XML::Simple;
use Net::Telnet::Trango;

use File::Basename;

my $me = basename($0);

print header,
      start_html('Trango SU Utilities'),
      h1('Trango SU Utilities');

my $aps = get_aps($host_file);

if (param()) {

	my $AP = param('AP');

	unless (exists $aps->{$AP}) {
		print h3("AP '$AP' does not exist!");
		print end_html;
		exit;
	}

	my $sumac = param('sumac');

	$sumac =~ s/[^0-9A-Fa-f]//g;
	$sumac = uc($sumac);

	my $suid = param('suid');

	if (length $sumac == 12) {
		add_su($aps->{$AP}, $sumac);
	} elsif (length $suid) {
		testrflink($aps->{$AP}, $suid);
	} else {
		print h3("Invalid SUID '$suid' and MAC '$sumac'");
		show_form($aps, $default_mac);
	}

} else {
	show_form($aps, $default_mac);
}


print end_html;


sub get_aps
{
	my $file = shift;

	my $conf = Read_Hosts($file);

	my %aps;

	foreach my $ap (@{ $conf }) {
		if ($ap->{'group'} eq 'Trango') {
			my $name = $ap->{'comment'} || $ap->{'name'};
			$aps{ $name } = $ap;
		}
	}

	return \%aps;

	return { 
		'rrlhcwap0000' => {
			group   => 'Trango',
			version => 1,
			name    => '192.168.1.1',
			port    => 161,
			Read_Community => 'private',
			Write_Community => 'private',
		}
	};

}

sub show_form
{
	my $aps  = shift;

	my %cache = ();
	my @ap_names = sort {
		my @a = $a =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/;
		my @b = $b =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/;

		if (@a) {
			$cache{$a} ||= pack('C4' => @a);
		} else {
			$cache{$a} ||= lc($a);
		}
		if (@b) {
			$cache{$b} ||= pack('C4' => @b);
		} else {
			$cache{$b} ||= lc($b);
		}

		$cache{$a} cmp $cache{$b};
	} keys %{ $aps };

    print p(start_form(-method => 'GET'),
		'AP:    ', popup_menu(-name=>'AP', -values=>\@ap_names),br,
	    'SUMAC: ', textfield(-name=>'sumac',-default=>$default_mac),br,
	    'SUID:  ', textfield(-name=>'suid',-default=>$default_suid),br,
        submit,
        end_form);

	print p('Fill in the SUMAC if you wish to add an SU ',
	  'or fill in the SUID to run an rflinktest.');

	return 1;
}

sub login
{
	my $host     = shift;
	my $password = shift;

	my $t = new Net::Telnet::Trango ( Timeout => 5 );

	#$t->input_log('/tmp/telnet_log');
	#$t->dump_log('/tmp/telnet_log');

	unless ($t->open( Host => $host )) {
		print h3("Error connecting!");
		$t->close;
		return undef;
	}

	unless ($t->login( $password ) ) {
		print h3("Couldn't log in: $!");
		$t->exit;
		$t->close;
		return undef;
	}

	return $t;
}

sub add_su
{
	my $ap  = shift;
	my $sumac = shift;

	my $t = login($ap->{'name'}, $ap->{'Telnet_Password'});

	my $cur_sus = $t->sudb_view;

	my $new_suid = next_suid($cur_sus);

	foreach my $su (@{ $cur_sus }) {
		if ($sumac eq $su->{'mac'}) {
			print h3("MAC '$sumac' already in AP '$ap->{'name'}' with SUID '$su->{'suid'}'");
			$t->exit;
			$t->close;
			return undef;
		}
	}

	unless ($t->sudb_add(
		$new_suid, 'reg', $default_cir, $default_mir, $sumac
	) ) {
		print h3("Error adding SU!");
		$t->exit;
		$t->close;
		return undef;
	}

	my $new_sus = $t->sudb_view;
	my $added = 0;
	foreach my $su (@{ $new_sus }) {
		if ($su->{'suid'} == $new_suid) {
			$added = 1;
			last;
		}
	}

	unless ($added) {
		print h3("Couldn't add su id: $new_suid");
		$t->exit;
		$t->close;
		return undef;
	}

	unless ($t->save_sudb) {
		print h3("Couldn't save sudb");
		$t->exit;
		$t->close;
		return undef;
	}

	print p(
		"Added new SU with ID '$new_suid' " .
		"and MAC '$sumac' " .
		"to '$ap->{'name'}'.  " .
		'<a href="' . $me . '?' . 
		'AP=' . $ap->{'name'} . '&' . 
		'suid=' . $new_suid . 
		'">Test SU RFLink</a>'
	);

	$t->exit;
	$t->close;
	return 1;

}

sub testrflink
{
	my $ap  = shift;
	my $suid = shift;

	my $t = login($ap->{'name'}, $ap->{'Telnet_Password'});

	my $result = $t->su_testrflink( $suid );

	unless ($result) {
		print h3("Error testing SU rflink!");
		$t->exit;
		$t->close;
		return undef;
	}

	my @keys = ('suid', 'AP Tx', 'AP Rx', 'SU Rx');

	my @table;
	foreach my $su (@{ $result }) {
		next unless ref $su eq 'HASH';
		next unless exists $su->{'suid'};
		$su->{'suid'} =~ s/\D//g;
		next unless $su->{'suid'};

		push @table, td([ @{ $su }{ @keys } ]);
	}

	print table({-border=>1,-cellspacing=>0,-cellpadding=>1},
		caption($ap->{'name'} . ': su testrflink ' . $suid),
		Tr({-align=>'CENTER', -valign=>'TOP'},
			[ th(\@keys), @table ]
		)
	);

	$t->exit;
	$t->close;
	return 1;

}

sub next_suid
{
	my $sudb = shift;

	my $next_id = $Start_SUID;

	my %ids = map { $_->{'suid'} => 1 } @{ $sudb };

	my $next_key = sprintf('%04d', $next_id);
	while (exists $ids{$next_key}) {
		$next_id++;
		$next_key = sprintf('%04d', $next_id);
	}

	return $next_id;
}

sub Read_Hosts
{
    my $file = shift;
    my $xs = XML::Simple->new();

	my %Default_SNMP = (
    	Read_Community => 'public',
		Telnet_Password => 'password',
    	port => 161,
    	version => 1,
	);

    my @hosts;
    my $hosts = $xs->XMLin($file,
        keyattr => [ 'Station' ],
        ForceArray => qr/^Host$/,
    );

    foreach my $group (keys %{ $hosts }) {
        next if $group eq 'Read_Community';

        foreach my $host (@{ $hosts->{$group}->{Host} }) {
            foreach my $item ('Read_Community', 'Telnet_Password', 'port', 'version') {
                $host->{$item} =
                    $host->{$item} ||
                    $hosts->{$group}->{$item} ||
                    $hosts->{$item} ||
                    $Default_SNMP{$item};
            }
            $host->{group} = $group;

            push @hosts, $host;
        }
    }

    return \@hosts;
}