Return to su.cgi CVS log

Up to [local] / trango / Net-Telnet-Trango / scripts

Make the example work without our special XML file.

#!/usr/bin/perl
# $RedRiver: su.cgi,v 1.1 2007/02/07 16:55:12 andrew Exp $
########################################################################
# 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 = 'su.yaml';

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 File::Basename;
use YAML qw/ LoadFile Dump /;
use Net::Telnet::Trango;

my $me = basename($0);

my $aps = get_aps($host_file);

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

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 = LoadFile($file);

	my %aps;

	foreach my $ap (keys %{ $conf }) {
		next if $ap eq 'default';
		$aps{ $ap } = $conf->{$ap};
		if (ref $conf->{default} eq 'HASH') {
			foreach my $k (keys %{ $conf->{default} }) {
				$aps{ $ap }{$k} ||= $conf->{default}->{$k};
			}
		}
	}

	return \%aps;

	return { 
		'rrlhcwap0000' => {
			name     => '192.168.1.1',
			password => 'trango',
		}
	};

}

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->{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->{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;
}