Annotation of trango/Net-Telnet-Trango/scripts/su.cgi, Revision 1.6
1.1 andrew 1: #!/usr/bin/perl
1.6 ! andrew 2: # $RedRiver: su.cgi,v 1.5 2008/09/04 20:53:55 andrew Exp $
1.1 andrew 3: ########################################################################
4: # su.cgi *** a CGI for Trango SU utilities.
1.5 andrew 5: #
1.1 andrew 6: # 2007.02.07 #*#*# andrew fresh <andrew@mad-techies.org>
7: ########################################################################
8: # Copyright (C) 2007 by Andrew Fresh
1.5 andrew 9: #
10: # This program is free software; you can redistribute it and/or modify
1.1 andrew 11: # it under the same terms as Perl itself.
12: ########################################################################
13: use strict;
14: use warnings;
15:
1.2 andrew 16: my $host_file = 'su.yaml';
1.1 andrew 17:
1.6 ! andrew 18: my $default_timeout = 5;
1.5 andrew 19: my $default_mac = '0001DE';
20: my $default_suid = 'all';
21: my $default_cir = 256;
22: my $default_mir = 9999;
23: my $Start_SUID = 3;
1.1 andrew 24:
25: use CGI qw/:standard/;
1.4 andrew 26: use YAML qw/ LoadFile Dump /;
1.1 andrew 27: use Net::Telnet::Trango;
28:
1.6 ! andrew 29: print header;
1.1 andrew 30:
1.2 andrew 31: my $aps = get_aps($host_file);
1.1 andrew 32:
1.6 ! andrew 33: my ( $header, $body );
! 34: my $head;
! 35: my $show_form = 0;
1.1 andrew 36:
1.5 andrew 37: if ( param() ) {
1.3 andrew 38: my $AP = param('AP');
1.1 andrew 39:
1.5 andrew 40: unless ( exists $aps->{$AP} ) {
1.3 andrew 41: print h3("AP '$AP' does not exist!");
42: print end_html;
43: exit;
44: }
45:
1.6 ! andrew 46: my $sumac = param('sumac') || '';
1.3 andrew 47: $sumac =~ s/[^0-9A-Fa-f]//g;
48: $sumac = uc($sumac);
49:
1.6 ! andrew 50: my $suid = param('suid');
! 51: my $test_type = param('test_type');
1.3 andrew 52:
1.5 andrew 53: if ( length $sumac == 12 ) {
1.6 ! andrew 54: ( $header, $body ) = add_su( $aps->{$AP}, $sumac, $suid );
1.5 andrew 55: }
56: elsif ( length $suid ) {
1.6 ! andrew 57: if ( $test_type && $test_type eq 'linktest' ) {
! 58: ( $header, $body ) = linktest( $aps->{$AP}, $suid );
! 59: }
! 60: else {
! 61: ( $header, $body ) = testrflink( $aps->{$AP}, $suid );
! 62: $head = '<meta http-equiv=refresh content=5>';
! 63: }
1.5 andrew 64: }
65: else {
1.6 ! andrew 66: $header = "Invalid SUID '$suid' and MAC '$sumac'";
! 67: $show_form = 1;
1.3 andrew 68: }
1.1 andrew 69:
70: }
1.5 andrew 71: else {
1.6 ! andrew 72: $show_form = 1;
1.5 andrew 73: }
1.1 andrew 74:
1.6 ! andrew 75: if ($header) {
! 76:
! 77: # We don't really want to do this here because we don't want to refresh if we're adding an SU
! 78: if ($head) {
! 79: print start_html( -title => $header, -head => ["$head"] );
! 80: }
! 81: else {
! 82: print start_html($header);
! 83: }
! 84: if ( not defined param('bare') ) {
! 85: print h1($header);
! 86: }
! 87:
! 88: if ($body) {
! 89: print $body;
! 90: }
! 91: }
! 92: else {
! 93: print start_html('Trango SU Utilities'), h1('Trango SU Utilities');
! 94: }
! 95:
! 96: show_form( $aps, $default_mac ) if $show_form;
! 97:
1.1 andrew 98: print end_html;
99:
1.5 andrew 100: sub get_aps {
1.3 andrew 101: my $file = shift;
1.1 andrew 102:
1.3 andrew 103: my $conf = LoadFile($file);
1.1 andrew 104:
1.3 andrew 105: my %aps;
1.1 andrew 106:
1.4 andrew 107: my @hosts;
1.5 andrew 108: foreach my $ap ( keys %{$conf} ) {
1.3 andrew 109: next if $ap eq 'default';
1.5 andrew 110: my $h = $conf->{$ap};
1.4 andrew 111:
1.5 andrew 112: if ( $h->{name}
113: =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.)(\d{1,3})-(\d{1,3})/ )
114: {
115: for ( $2 .. $3 ) {
1.4 andrew 116: my %cur_host;
1.5 andrew 117: foreach my $k ( keys %{$h} ) {
1.4 andrew 118: $cur_host{$k} = $h->{$k};
119: }
120: $cur_host{name} = $1 . $_;
1.5 andrew 121: if ( !grep { $cur_host{name} eq $h->{name} } values %aps ) {
122: my $ap_name = $ap . $_;
123: $aps{$ap_name} = \%cur_host;
1.4 andrew 124: }
125: }
1.5 andrew 126: }
127: else {
128: $aps{$ap} = $conf->{$ap};
1.4 andrew 129: push @hosts, $h;
130: }
131: }
132:
1.5 andrew 133: if ( ref $conf->{default} eq 'HASH' ) {
134: foreach my $ap ( keys %aps ) {
135: foreach my $k ( keys %{ $conf->{default} } ) {
136: $aps{$ap}{$k} ||= $conf->{default}->{$k};
1.3 andrew 137: }
138: }
139: }
140:
141: return \%aps;
142:
1.5 andrew 143: return {
1.3 andrew 144: 'rrlhcwap0000' => {
1.6 ! andrew 145: group => 'Trango',
! 146: version => 1,
! 147: name => '192.168.1.1',
! 148: port => 161,
! 149: Read_Community => 'private',
! 150: Write_Community => 'private',
1.3 andrew 151: }
152: };
1.1 andrew 153:
154: }
155:
1.5 andrew 156: sub show_form {
157: my $aps = shift;
1.1 andrew 158:
1.5 andrew 159: my %cache = ();
1.3 andrew 160: my @ap_names = sort {
161: my @a = $a =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/;
162: my @b = $b =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/;
163:
164: if (@a) {
1.5 andrew 165: $cache{$a} ||= pack( 'C4' => @a );
166: }
167: else {
1.3 andrew 168: $cache{$a} ||= lc($a);
169: }
170: if (@b) {
1.5 andrew 171: $cache{$b} ||= pack( 'C4' => @b );
172: }
173: else {
1.3 andrew 174: $cache{$b} ||= lc($b);
175: }
1.1 andrew 176:
1.3 andrew 177: $cache{$a} cmp $cache{$b};
1.5 andrew 178: } keys %{$aps};
1.1 andrew 179:
1.5 andrew 180: print p(
181: start_form( -method => 'GET' ),
182: 'AP: ',
183: popup_menu( -name => 'AP', -values => \@ap_names ),
184: br,
185: 'SUMAC: ',
186: textfield( -name => 'sumac', -default => $default_mac ),
187: br,
188: 'SUID: ',
189: textfield( -name => 'suid', -default => $default_suid ),
190: br,
1.6 ! andrew 191: 'Test Type: ',
! 192: radio_group(
! 193: -name => 'test_type',
! 194: -values => [ 'su testrflink', 'linktest' ],
! 195: -default => 'su testrflink',
! 196: ),
! 197: br, submit, end_form
1.5 andrew 198: );
1.1 andrew 199:
1.5 andrew 200: print p(
201: 'Fill in the SUMAC if you wish to add an SU ',
1.6 ! andrew 202: 'or fill in the SUID to run an RF link test. ',
! 203: 'If you enter both a valid SUMAC and a numeric SUID, ',
! 204: 'the SU will be added with that SUID. ',
! 205: 'If the SUID is already in the AP, it will be deleted ',
! 206: 'before the new SU is added. '
1.5 andrew 207: );
1.1 andrew 208:
1.3 andrew 209: return 1;
1.1 andrew 210: }
211:
1.5 andrew 212: sub login {
1.3 andrew 213: my $host = shift;
214: my $password = shift;
1.1 andrew 215:
1.6 ! andrew 216: my $t = new Net::Telnet::Trango( Timeout => $default_timeout );
1.1 andrew 217:
1.3 andrew 218: #$t->input_log('/tmp/telnet_log');
219: #$t->dump_log('/tmp/telnet_log');
1.1 andrew 220:
1.5 andrew 221: unless ( $t->open( Host => $host ) ) {
1.3 andrew 222: print h3("Error connecting!");
223: $t->close;
224: return undef;
225: }
226:
1.5 andrew 227: unless ( $t->login($password) ) {
1.3 andrew 228: print h3("Couldn't log in: $!");
229: $t->exit;
230: $t->close;
231: return undef;
232: }
1.1 andrew 233:
1.3 andrew 234: return $t;
1.1 andrew 235: }
236:
1.5 andrew 237: sub add_su {
1.6 ! andrew 238: my ( $ap, $sumac, $suid ) = @_;
1.1 andrew 239:
1.6 ! andrew 240: my $t = login( $ap->{'name'}, $ap->{'Telnet_Password'} );
1.1 andrew 241:
1.3 andrew 242: my $cur_sus = $t->sudb_view;
1.1 andrew 243:
1.6 ! andrew 244: my $new_suid = $suid;
! 245: $new_suid =~ s/\D//gxms;
1.1 andrew 246:
1.6 ! andrew 247: if ( !$new_suid ) {
! 248: $new_suid = next_suid($cur_sus);
! 249: }
! 250:
! 251: my $old_su = '';
1.5 andrew 252: foreach my $su ( @{$cur_sus} ) {
1.6 ! andrew 253: if ( $new_suid == $su->{'suid'} ) {
! 254: $old_su = $su;
! 255: }
! 256:
! 257: if ( $sumac eq $su->{'mac'} ) {
1.3 andrew 258: $t->exit;
259: $t->close;
1.6 ! andrew 260: return "MAC '$sumac' already in AP '$ap->{'name'}' "
! 261: . "with SUID '$su->{'suid'}'";
1.3 andrew 262: }
263: }
264:
1.6 ! andrew 265: my $cir = $default_cir;
! 266: my $mir = $default_mir;
! 267:
! 268: if ($old_su) {
! 269: $cir = $old_su->{'cir'} if $old_su->{'cir'};
! 270: $mir = $old_su->{'mir'} if $old_su->{'mir'};
! 271:
! 272: if ( !$t->sudb_delete($new_suid) ) {
! 273: $t->exit;
! 274: $t->close;
! 275: return "Error removing SU!";
! 276: }
! 277: }
! 278:
! 279: if ( !$t->sudb_add( $new_suid, 'reg', $cir, $mir, $sumac ) ) {
1.3 andrew 280: $t->exit;
281: $t->close;
1.6 ! andrew 282: return "Error adding SU!";
1.3 andrew 283: }
284:
285: my $new_sus = $t->sudb_view;
1.5 andrew 286: my $added = 0;
287: foreach my $su ( @{$new_sus} ) {
1.6 ! andrew 288: if ( $su->{'suid'} == $new_suid ) {
1.3 andrew 289: $added = 1;
290: last;
291: }
292: }
293:
294: unless ($added) {
295: $t->exit;
296: $t->close;
1.6 ! andrew 297: return "Couldn't add su id: $new_suid";
1.3 andrew 298: }
299:
1.5 andrew 300: unless ( $t->save_sudb ) {
1.3 andrew 301: $t->exit;
302: $t->close;
1.6 ! andrew 303: return "Couldn't save sudb";
1.3 andrew 304: }
305:
306: $t->exit;
307: $t->close;
1.1 andrew 308:
1.6 ! andrew 309: my $msg = '';
! 310:
! 311: if ($old_su) {
! 312: $msg
! 313: .= "Removed old SU with ID '$new_suid' "
! 314: . "and MAC '"
! 315: . $old_su->{'mac'} . "' "
! 316: . "from '$ap->{'name'}'. ";
! 317: }
! 318:
! 319: $msg
! 320: .= "Added new SU with ID '$new_suid' "
! 321: . "and MAC '$sumac' "
! 322: . "to '$ap->{'name'}'. "
! 323: . '<a href="'
! 324: . url(-relative => 1)
! 325: . '?' . 'AP='
! 326: . $ap->{'name'} . '&' . 'suid='
! 327: . $new_suid
! 328: . '">Test SU RFLink</a>';
! 329:
! 330: return $msg;
1.1 andrew 331: }
332:
1.5 andrew 333: sub testrflink {
334: my $ap = shift;
1.3 andrew 335: my $suid = shift;
1.1 andrew 336:
1.6 ! andrew 337: my $t = login( $ap->{'name'}, $ap->{'Telnet_Password'} );
1.1 andrew 338:
1.6 ! andrew 339: my $timeout = $default_timeout;
! 340: if ( $suid eq 'all' ) {
! 341: my $sudb = $t->sudb_view();
! 342: my $count = scalar @{$sudb};
! 343: $timeout = $count * $default_timeout;
! 344: }
! 345: my $result = $t->su_testrflink( args => $suid, Timeout => $timeout );
1.1 andrew 346:
1.3 andrew 347: unless ($result) {
348: $t->exit;
349: $t->close;
1.6 ! andrew 350: return "Error testing SU rflink!";
1.3 andrew 351: }
352:
1.5 andrew 353: my @keys = ( 'suid', 'AP Tx', 'AP Rx', 'SU Rx' );
1.3 andrew 354:
355: my @table;
1.5 andrew 356: foreach my $su ( @{$result} ) {
1.3 andrew 357: next unless ref $su eq 'HASH';
1.6 ! andrew 358: next unless exists $su->{'suid'};
! 359: $su->{'suid'} =~ s/\D//g;
! 360: next unless $su->{'suid'};
1.3 andrew 361:
1.5 andrew 362: push @table, td( [ @{$su}{@keys} ] );
1.3 andrew 363: }
364:
1.6 ! andrew 365: $t->exit;
! 366: $t->close;
! 367: return $ap->{'name'} . ': su testrflink ' . $suid,
! 368: table(
1.5 andrew 369: { -border => 1, -cellspacing => 0, -cellpadding => 1 },
370: Tr( { -align => 'CENTER', -valign => 'TOP' },
371: [ th( \@keys ), @table ]
1.3 andrew 372: )
1.6 ! andrew 373: );
! 374:
! 375: }
! 376:
! 377: sub linktest {
! 378: my $ap = shift;
! 379: my $suid = shift;
! 380:
! 381: if ( !$suid =~ /^\d+$/ ) {
! 382: return "Invalid SUID [$suid]";
! 383: }
! 384:
! 385: my $t = login( $ap->{'name'}, $ap->{'Telnet_Password'} );
! 386:
! 387: my $result = $t->linktest($suid);
1.3 andrew 388:
389: $t->exit;
390: $t->close;
1.1 andrew 391:
1.6 ! andrew 392: unless ($result) {
! 393: return "Error testing SU rflink!";
! 394: }
! 395:
! 396: my @keys = (
! 397: { caption => 'Overview',
! 398: fields => [
! 399: 'AP to SU Error Rate',
! 400: 'SU to AP Error Rate',
! 401: 'Avg of Throughput',
! 402: ],
! 403: },
! 404: { caption => 'Details',
! 405: fields => [
! 406: 'AP Total nTx',
! 407: 'AP Total nRx',
! 408: 'AP Total nRxErr',
! 409:
! 410: 'SU Total nTx',
! 411: 'SU Total nRx',
! 412: 'SU Total nRxErr',
! 413: ],
! 414: },
! 415: );
! 416:
! 417: my @detail_keys = (
! 418: 'AP Tx', 'AP Rx', 'AP RxErr', 'SU Tx',
! 419: 'SU Rx', 'SU RxErr', 'time', 'rate',
! 420: );
! 421:
! 422: my $html;
! 423: foreach my $keys (@keys) {
! 424: my @table;
! 425: foreach my $k ( @{ $keys->{fields} } ) {
! 426: if ( $result->{$k} ) {
! 427: push @table, td( [ b($k), $result->{$k} ] );
! 428: }
! 429: else {
! 430: push @table, td( [] );
! 431: }
! 432: }
! 433: $html .= table(
! 434: { -border => 1, -cellspacing => 0, -cellpadding => 1, },
! 435: caption( $keys->{caption} ),
! 436: Tr( { -align => 'CENTER', -valign => 'TOP' }, \@table ),
! 437: );
! 438: }
! 439:
! 440: my @detail_table;
! 441: foreach my $test ( @{ $result->{tests} } ) {
! 442: push @detail_table, td( [ @{$test}{@detail_keys} ] );
! 443: }
! 444: $html .= table(
! 445: { -border => 1, -cellspacing => 0, -cellpadding => 1 },
! 446: caption('Test Details'),
! 447: Tr( { -align => 'CENTER', -valign => 'TOP' },
! 448: [ th( \@detail_keys ), @detail_table, ],
! 449: ),
! 450: );
! 451:
! 452: return $ap->{'name'} . ': linktest ' . $suid, $html;
1.1 andrew 453: }
454:
1.5 andrew 455: sub next_suid {
1.3 andrew 456: my $sudb = shift;
1.1 andrew 457:
1.3 andrew 458: my $next_id = $Start_SUID;
1.1 andrew 459:
1.6 ! andrew 460: my %ids = map { $_->{'suid'} => 1 } @{$sudb};
1.1 andrew 461:
1.5 andrew 462: my $next_key = sprintf( '%04d', $next_id );
463: while ( exists $ids{$next_key} ) {
1.3 andrew 464: $next_id++;
1.5 andrew 465: $next_key = sprintf( '%04d', $next_id );
1.3 andrew 466: }
1.1 andrew 467:
1.3 andrew 468: return $next_id;
1.1 andrew 469: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to su.cgi CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / trango / Net-Telnet-Trango / scripts