===================================================================
RCS file: /cvs/trango/Net-Telnet-Trango/scripts/su.cgi,v
retrieving revision 1.2
retrieving revision 1.6
diff -u -r1.2 -r1.6
--- trango/Net-Telnet-Trango/scripts/su.cgi	2007/02/07 17:42:56	1.2
+++ trango/Net-Telnet-Trango/scripts/su.cgi	2008/09/04 22:05:21	1.6
@@ -1,13 +1,13 @@
 #!/usr/bin/perl
-# $RedRiver: su.cgi,v 1.1 2007/02/07 16:55:12 andrew Exp $
+# $RedRiver: su.cgi,v 1.5 2008/09/04 20:53:55 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 
+#
+# This program is free software; you can redistribute it and/or modify
 # it under the same terms as Perl itself.
 ########################################################################
 use strict;
@@ -15,273 +15,455 @@
 
 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;
+my $default_timeout = 5;
+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);
+print header;
 
 my $aps = get_aps($host_file);
 
-print header,
-      start_html('Trango SU Utilities'),
-      h1('Trango SU Utilities');
+my ( $header, $body );
+my $head;
+my $show_form = 0;
 
-if (param()) {
+if ( param() ) {
+    my $AP = param('AP');
 
-	my $AP = param('AP');
+    unless ( exists $aps->{$AP} ) {
+        print h3("AP '$AP' does not exist!");
+        print end_html;
+        exit;
+    }
 
-	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 $sumac = param('sumac');
+    my $suid      = param('suid');
+    my $test_type = param('test_type');
 
-	$sumac =~ s/[^0-9A-Fa-f]//g;
-	$sumac = uc($sumac);
+    if ( length $sumac == 12 ) {
+        ( $header, $body ) = add_su( $aps->{$AP}, $sumac, $suid );
+    }
+    elsif ( length $suid ) {
+        if ( $test_type && $test_type eq 'linktest' ) {
+            ( $header, $body ) = linktest( $aps->{$AP}, $suid );
+        }
+        else {
+            ( $header, $body ) = testrflink( $aps->{$AP}, $suid );
+            $head = '<meta http-equiv=refresh content=5>';
+        }
+    }
+    else {
+        $header    = "Invalid SUID '$suid' and MAC '$sumac'";
+        $show_form = 1;
+    }
 
-	my $suid = param('suid');
+}
+else {
+    $show_form = 1;
+}
 
-	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);
-	}
+if ($header) {
 
-} else {
-	show_form($aps, $default_mac);
+# We don't really want to do this here because we don't want to refresh if we're adding an SU
+    if ($head) {
+        print start_html( -title => $header, -head => ["$head"] );
+    }
+    else {
+        print start_html($header);
+    }
+    if ( not defined param('bare') ) {
+        print h1($header);
+    }
+
+    if ($body) {
+        print $body;
+    }
 }
+else {
+    print start_html('Trango SU Utilities'), h1('Trango SU Utilities');
+}
 
+show_form( $aps, $default_mac ) if $show_form;
 
 print end_html;
 
+sub get_aps {
+    my $file = shift;
 
-sub get_aps
-{
-	my $file = shift;
+    my $conf = LoadFile($file);
 
-	my $conf = LoadFile($file);
+    my %aps;
 
-	my %aps;
+    my @hosts;
+    foreach my $ap ( keys %{$conf} ) {
+        next if $ap eq 'default';
+        my $h = $conf->{$ap};
 
-	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};
-			}
-		}
-	}
+        if ( $h->{name}
+            =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.)(\d{1,3})-(\d{1,3})/ )
+        {
+            for ( $2 .. $3 ) {
+                my %cur_host;
+                foreach my $k ( keys %{$h} ) {
+                    $cur_host{$k} = $h->{$k};
+                }
+                $cur_host{name} = $1 . $_;
+                if ( !grep { $cur_host{name} eq $h->{name} } values %aps ) {
+                    my $ap_name = $ap . $_;
+                    $aps{$ap_name} = \%cur_host;
+                }
+            }
+        }
+        else {
+            $aps{$ap} = $conf->{$ap};
+            push @hosts, $h;
+        }
+    }
 
-	return \%aps;
+    if ( ref $conf->{default} eq 'HASH' ) {
+        foreach my $ap ( keys %aps ) {
+            foreach my $k ( keys %{ $conf->{default} } ) {
+                $aps{$ap}{$k} ||= $conf->{default}->{$k};
+            }
+        }
+    }
 
-	return { 
-		'rrlhcwap0000' => {
-			name     => '192.168.1.1',
-			password => 'trango',
-		}
-	};
+    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;
+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+)/;
+    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);
-		}
+        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 };
+        $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(
+        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,
+        'Test Type: ',
+        radio_group(
+            -name    => 'test_type',
+            -values  => [ 'su testrflink', 'linktest' ],
+            -default => 'su testrflink',
+        ),
+        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.');
+    print p(
+        'Fill in the SUMAC if you wish to add an SU ',
+        'or fill in the SUID to run an RF link test.  ',
+        'If you enter both a valid SUMAC and a numeric SUID, ',
+        'the SU will be added with that SUID.  ',
+        'If the SUID is already in the AP, it will be deleted ',
+        'before the new SU is added.  '
+    );
 
-	return 1;
+    return 1;
 }
 
-sub login
-{
-	my $host     = shift;
-	my $password = shift;
+sub login {
+    my $host     = shift;
+    my $password = shift;
 
-	my $t = new Net::Telnet::Trango ( Timeout => 5 );
+    my $t = new Net::Telnet::Trango( Timeout => $default_timeout );
 
-	#$t->input_log('/tmp/telnet_log');
-	#$t->dump_log('/tmp/telnet_log');
+    #$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->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;
-	}
+    unless ( $t->login($password) ) {
+        print h3("Couldn't log in: $!");
+        $t->exit;
+        $t->close;
+        return undef;
+    }
 
-	return $t;
+    return $t;
 }
 
-sub add_su
-{
-	my $ap  = shift;
-	my $sumac = shift;
+sub add_su {
+    my ( $ap, $sumac, $suid ) = @_;
 
-	my $t = login($ap->{name}, $ap->{password});
+    my $t = login( $ap->{'name'}, $ap->{'Telnet_Password'} );
 
-	my $cur_sus = $t->sudb_view;
+    my $cur_sus = $t->sudb_view;
 
-	my $new_suid = next_suid($cur_sus);
+    my $new_suid = $suid;
+    $new_suid =~ s/\D//gxms;
 
-	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;
-		}
-	}
+    if ( !$new_suid ) {
+        $new_suid = next_suid($cur_sus);
+    }
 
-	unless ($t->sudb_add(
-		$new_suid, 'reg', $default_cir, $default_mir, $sumac
-	) ) {
-		print h3("Error adding SU!");
-		$t->exit;
-		$t->close;
-		return undef;
-	}
+    my $old_su = '';
+    foreach my $su ( @{$cur_sus} ) {
+        if ( $new_suid == $su->{'suid'} ) {
+            $old_su = $su;
+        }
 
-	my $new_sus = $t->sudb_view;
-	my $added = 0;
-	foreach my $su (@{ $new_sus }) {
-		if ($su->{suid} == $new_suid) {
-			$added = 1;
-			last;
-		}
-	}
+        if ( $sumac eq $su->{'mac'} ) {
+            $t->exit;
+            $t->close;
+            return "MAC '$sumac' already in AP '$ap->{'name'}' "
+                . "with SUID '$su->{'suid'}'";
+        }
+    }
 
-	unless ($added) {
-		print h3("Couldn't add su id: $new_suid");
-		$t->exit;
-		$t->close;
-		return undef;
-	}
+    my $cir = $default_cir;
+    my $mir = $default_mir;
 
-	unless ($t->save_sudb) {
-		print h3("Couldn't save sudb");
-		$t->exit;
-		$t->close;
-		return undef;
-	}
+    if ($old_su) {
+        $cir = $old_su->{'cir'} if $old_su->{'cir'};
+        $mir = $old_su->{'mir'} if $old_su->{'mir'};
 
-	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>'
-	);
+        if ( !$t->sudb_delete($new_suid) ) {
+            $t->exit;
+            $t->close;
+            return "Error removing SU!";
+        }
+    }
 
-	$t->exit;
-	$t->close;
-	return 1;
+    if ( !$t->sudb_add( $new_suid, 'reg', $cir, $mir, $sumac ) ) {
+        $t->exit;
+        $t->close;
+        return "Error adding SU!";
+    }
 
+    my $new_sus = $t->sudb_view;
+    my $added   = 0;
+    foreach my $su ( @{$new_sus} ) {
+        if ( $su->{'suid'} == $new_suid ) {
+            $added = 1;
+            last;
+        }
+    }
+
+    unless ($added) {
+        $t->exit;
+        $t->close;
+        return "Couldn't add su id: $new_suid";
+    }
+
+    unless ( $t->save_sudb ) {
+        $t->exit;
+        $t->close;
+        return "Couldn't save sudb";
+    }
+
+    $t->exit;
+    $t->close;
+
+    my $msg = '';
+
+    if ($old_su) {
+        $msg
+            .= "Removed old SU with ID '$new_suid' "
+            . "and MAC '"
+            . $old_su->{'mac'} . "' "
+            . "from '$ap->{'name'}'.  ";
+    }
+
+    $msg
+        .= "Added new SU with ID '$new_suid' "
+        . "and MAC '$sumac' "
+        . "to '$ap->{'name'}'.  "
+        . '<a href="'
+        . url(-relative => 1)
+        . '?' . 'AP='
+        . $ap->{'name'} . '&' . 'suid='
+        . $new_suid
+        . '">Test SU RFLink</a>';
+
+    return $msg;
 }
 
-sub testrflink
-{
-	my $ap  = shift;
-	my $suid = shift;
+sub testrflink {
+    my $ap   = shift;
+    my $suid = shift;
 
-	my $t = login($ap->{name}, $ap->{password});
+    my $t = login( $ap->{'name'}, $ap->{'Telnet_Password'} );
 
-	my $result = $t->su_testrflink( $suid );
+    my $timeout = $default_timeout;
+    if ( $suid eq 'all' ) {
+        my $sudb  = $t->sudb_view();
+        my $count = scalar @{$sudb};
+        $timeout = $count * $default_timeout;
+    }
+    my $result = $t->su_testrflink( args => $suid, Timeout => $timeout );
 
-	unless ($result) {
-		print h3("Error testing SU rflink!");
-		$t->exit;
-		$t->close;
-		return undef;
-	}
+    unless ($result) {
+        $t->exit;
+        $t->close;
+        return "Error testing SU rflink!";
+    }
 
-	my @keys = ('suid', 'AP Tx', 'AP Rx', 'SU Rx');
+    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};
+    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 } ]);
-	}
+        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 $ap->{'name'} . ': su testrflink ' . $suid,
+        table(
+        { -border => 1, -cellspacing => 0, -cellpadding => 1 },
+        Tr( { -align => 'CENTER', -valign => 'TOP' },
+            [ th( \@keys ), @table ]
+        )
+        );
 
-	$t->exit;
-	$t->close;
-	return 1;
+}
 
+sub linktest {
+    my $ap   = shift;
+    my $suid = shift;
+
+    if ( !$suid =~ /^\d+$/ ) {
+        return "Invalid SUID [$suid]";
+    }
+
+    my $t = login( $ap->{'name'}, $ap->{'Telnet_Password'} );
+
+    my $result = $t->linktest($suid);
+
+    $t->exit;
+    $t->close;
+
+    unless ($result) {
+        return "Error testing SU rflink!";
+    }
+
+    my @keys = (
+        {   caption => 'Overview',
+            fields  => [
+                'AP to SU Error Rate',
+                'SU to AP Error Rate',
+                'Avg of Throughput',
+            ],
+        },
+        {   caption => 'Details',
+            fields  => [
+                'AP Total nTx',
+                'AP Total nRx',
+                'AP Total nRxErr',
+
+                'SU Total nTx',
+                'SU Total nRx',
+                'SU Total nRxErr',
+            ],
+        },
+    );
+
+    my @detail_keys = (
+        'AP Tx', 'AP Rx',    'AP RxErr', 'SU Tx',
+        'SU Rx', 'SU RxErr', 'time',     'rate',
+    );
+
+    my $html;
+    foreach my $keys (@keys) {
+        my @table;
+        foreach my $k ( @{ $keys->{fields} } ) {
+            if ( $result->{$k} ) {
+                push @table, td( [ b($k), $result->{$k} ] );
+            }
+            else {
+                push @table, td( [] );
+            }
+        }
+        $html .= table(
+            { -border => 1, -cellspacing => 0, -cellpadding => 1, },
+            caption( $keys->{caption} ),
+            Tr( { -align => 'CENTER', -valign => 'TOP' }, \@table ),
+        );
+    }
+
+    my @detail_table;
+    foreach my $test ( @{ $result->{tests} } ) {
+        push @detail_table, td( [ @{$test}{@detail_keys} ] );
+    }
+    $html .= table(
+        { -border => 1, -cellspacing => 0, -cellpadding => 1 },
+        caption('Test Details'),
+        Tr( { -align => 'CENTER', -valign => 'TOP' },
+            [ th( \@detail_keys ), @detail_table, ],
+        ),
+    );
+
+    return $ap->{'name'} . ': linktest ' . $suid, $html;
 }
 
-sub next_suid
-{
-	my $sudb = shift;
+sub next_suid {
+    my $sudb = shift;
 
-	my $next_id = $Start_SUID;
+    my $next_id = $Start_SUID;
 
-	my %ids = map { $_->{suid} => 1 } @{ $sudb };
+    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);
-	}
+    my $next_key = sprintf( '%04d', $next_id );
+    while ( exists $ids{$next_key} ) {
+        $next_id++;
+        $next_key = sprintf( '%04d', $next_id );
+    }
 
-	return $next_id;
+    return $next_id;
 }