Annotation of trango/Net-Telnet-Trango/scripts/su.cgi, Revision 1.4
1.1 andrew 1: #!/usr/bin/perl
1.4 ! andrew 2: # $RedRiver: su.cgi,v 1.3 2007/02/07 17:44:56 andrew Exp $
1.1 andrew 3: ########################################################################
4: # su.cgi *** a CGI for Trango SU utilities.
5: #
6: # 2007.02.07 #*#*# andrew fresh <andrew@mad-techies.org>
7: ########################################################################
8: # Copyright (C) 2007 by Andrew Fresh
9: #
10: # This program is free software; you can redistribute it and/or modify
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:
18: my $default_mac = '0001DE';
19: my $default_suid = 'all';
20: my $default_cir = 256;
21: my $default_mir = 9999;
22: my $Start_SUID = 3;
23:
24: use CGI qw/:standard/;
1.2 andrew 25: use File::Basename;
1.4 ! andrew 26: use YAML qw/ LoadFile Dump /;
1.1 andrew 27: use Net::Telnet::Trango;
28:
1.2 andrew 29: my $me = basename($0);
1.1 andrew 30:
1.2 andrew 31: my $aps = get_aps($host_file);
1.1 andrew 32:
33: print header,
34: start_html('Trango SU Utilities'),
35: h1('Trango SU Utilities');
36:
37: if (param()) {
38:
1.3 andrew 39: my $AP = param('AP');
1.1 andrew 40:
1.3 andrew 41: unless (exists $aps->{$AP}) {
42: print h3("AP '$AP' does not exist!");
43: print end_html;
44: exit;
45: }
46:
47: my $sumac = param('sumac');
48:
49: $sumac =~ s/[^0-9A-Fa-f]//g;
50: $sumac = uc($sumac);
51:
52: my $suid = param('suid');
53:
54: if (length $sumac == 12) {
55: add_su($aps->{$AP}, $sumac);
56: } elsif (length $suid) {
57: testrflink($aps->{$AP}, $suid);
58: } else {
59: print h3("Invalid SUID '$suid' and MAC '$sumac'");
60: show_form($aps, $default_mac);
61: }
1.1 andrew 62:
63: } else {
1.3 andrew 64: show_form($aps, $default_mac);
1.1 andrew 65: }
66:
67:
68: print end_html;
69:
70:
71: sub get_aps
72: {
1.3 andrew 73: my $file = shift;
1.1 andrew 74:
1.3 andrew 75: my $conf = LoadFile($file);
1.1 andrew 76:
1.3 andrew 77: my %aps;
1.1 andrew 78:
1.4 ! andrew 79: my @hosts;
1.3 andrew 80: foreach my $ap (keys %{ $conf }) {
81: next if $ap eq 'default';
1.4 ! andrew 82: my $h = $conf->{$ap};
! 83:
! 84: if ($h->{name} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.)(\d{1,3})-(\d{1,3})/) {
! 85: for ($2..$3) {
! 86: my %cur_host;
! 87: foreach my $k (keys %{ $h }) {
! 88: $cur_host{$k} = $h->{$k};
! 89: }
! 90: $cur_host{name} = $1 . $_;
! 91: if (! grep { $cur_host{name} eq $h->{name} } values %aps) {
! 92: my $ap_name = $ap . $_;
! 93: $aps{ $ap_name } = \%cur_host;
! 94: }
! 95: }
! 96: } else {
! 97: $aps{ $ap } = $conf->{$ap};
! 98: push @hosts, $h;
! 99: }
! 100: }
! 101:
! 102: if (ref $conf->{default} eq 'HASH') {
! 103: foreach my $ap (keys %aps) {
1.3 andrew 104: foreach my $k (keys %{ $conf->{default} }) {
105: $aps{ $ap }{$k} ||= $conf->{default}->{$k};
106: }
107: }
108: }
109:
110: return \%aps;
111:
112: return {
113: 'rrlhcwap0000' => {
114: name => '192.168.1.1',
115: password => 'trango',
116: }
117: };
1.1 andrew 118:
119: }
120:
121: sub show_form
122: {
1.3 andrew 123: my $aps = shift;
1.1 andrew 124:
1.3 andrew 125: my %cache = ();
126: my @ap_names = sort {
127: my @a = $a =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/;
128: my @b = $b =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/;
129:
130: if (@a) {
131: $cache{$a} ||= pack('C4' => @a);
132: } else {
133: $cache{$a} ||= lc($a);
134: }
135: if (@b) {
136: $cache{$b} ||= pack('C4' => @b);
137: } else {
138: $cache{$b} ||= lc($b);
139: }
1.1 andrew 140:
1.3 andrew 141: $cache{$a} cmp $cache{$b};
142: } keys %{ $aps };
1.1 andrew 143:
144: print p(start_form(-method => 'GET'),
1.3 andrew 145: 'AP: ', popup_menu(-name=>'AP', -values=>\@ap_names),br,
146: 'SUMAC: ', textfield( -name=>'sumac', -default=>$default_mac),br,
147: 'SUID: ', textfield( -name=>'suid', -default=>$default_suid),br,
1.1 andrew 148: submit,
149: end_form);
150:
1.3 andrew 151: print p('Fill in the SUMAC if you wish to add an SU ',
152: 'or fill in the SUID to run an rflinktest.');
1.1 andrew 153:
1.3 andrew 154: return 1;
1.1 andrew 155: }
156:
157: sub login
158: {
1.3 andrew 159: my $host = shift;
160: my $password = shift;
1.1 andrew 161:
1.3 andrew 162: my $t = new Net::Telnet::Trango ( Timeout => 5 );
1.1 andrew 163:
1.3 andrew 164: #$t->input_log('/tmp/telnet_log');
165: #$t->dump_log('/tmp/telnet_log');
1.1 andrew 166:
1.3 andrew 167: unless ($t->open( Host => $host )) {
168: print h3("Error connecting!");
169: $t->close;
170: return undef;
171: }
172:
173: unless ($t->login( $password ) ) {
174: print h3("Couldn't log in: $!");
175: $t->exit;
176: $t->close;
177: return undef;
178: }
1.1 andrew 179:
1.3 andrew 180: return $t;
1.1 andrew 181: }
182:
183: sub add_su
184: {
1.3 andrew 185: my $ap = shift;
186: my $sumac = shift;
1.1 andrew 187:
1.3 andrew 188: my $t = login($ap->{name}, $ap->{password});
1.1 andrew 189:
1.3 andrew 190: my $cur_sus = $t->sudb_view;
1.1 andrew 191:
1.3 andrew 192: my $new_suid = next_suid($cur_sus);
1.1 andrew 193:
1.3 andrew 194: foreach my $su (@{ $cur_sus }) {
195: if ($sumac eq $su->{mac}) {
196: print h3("MAC '$sumac' already in AP '$ap->{name}' " .
197: "with SUID '$su->{suid}'");
198: $t->exit;
199: $t->close;
200: return undef;
201: }
202: }
203:
204: unless ($t->sudb_add(
205: $new_suid, 'reg', $default_cir, $default_mir, $sumac
206: ) ) {
207: print h3("Error adding SU!");
208: $t->exit;
209: $t->close;
210: return undef;
211: }
212:
213: my $new_sus = $t->sudb_view;
214: my $added = 0;
215: foreach my $su (@{ $new_sus }) {
216: if ($su->{suid} == $new_suid) {
217: $added = 1;
218: last;
219: }
220: }
221:
222: unless ($added) {
223: print h3("Couldn't add su id: $new_suid");
224: $t->exit;
225: $t->close;
226: return undef;
227: }
228:
229: unless ($t->save_sudb) {
230: print h3("Couldn't save sudb");
231: $t->exit;
232: $t->close;
233: return undef;
234: }
235:
236: print p(
237: "Added new SU with ID '$new_suid' " .
238: "and MAC '$sumac' " .
239: "to '$ap->{name}'. " .
240: '<a href="' . $me . '?' .
241: 'AP=' . $ap->{name} . '&' .
242: 'suid=' . $new_suid .
243: '">Test SU RFLink</a>'
244: );
245:
246: $t->exit;
247: $t->close;
248: return 1;
1.1 andrew 249:
250: }
251:
252: sub testrflink
253: {
1.3 andrew 254: my $ap = shift;
255: my $suid = shift;
1.1 andrew 256:
1.3 andrew 257: my $t = login($ap->{name}, $ap->{password});
1.1 andrew 258:
1.3 andrew 259: my $result = $t->su_testrflink( $suid );
1.1 andrew 260:
1.3 andrew 261: unless ($result) {
262: print h3("Error testing SU rflink!");
263: $t->exit;
264: $t->close;
265: return undef;
266: }
267:
268: my @keys = ('suid', 'AP Tx', 'AP Rx', 'SU Rx');
269:
270: my @table;
271: foreach my $su (@{ $result }) {
272: next unless ref $su eq 'HASH';
273: next unless exists $su->{suid};
274: $su->{suid} =~ s/\D//g;
275: next unless $su->{suid};
276:
277: push @table, td([ @{ $su }{ @keys } ]);
278: }
279:
280: print table({-border=>1,-cellspacing=>0,-cellpadding=>1},
281: caption($ap->{name} . ': su testrflink ' . $suid),
282: Tr({-align=>'CENTER', -valign=>'TOP'},
283: [ th(\@keys), @table ]
284: )
285: );
286:
287: $t->exit;
288: $t->close;
289: return 1;
1.1 andrew 290:
291: }
292:
293: sub next_suid
294: {
1.3 andrew 295: my $sudb = shift;
1.1 andrew 296:
1.3 andrew 297: my $next_id = $Start_SUID;
1.1 andrew 298:
1.3 andrew 299: my %ids = map { $_->{suid} => 1 } @{ $sudb };
1.1 andrew 300:
1.3 andrew 301: my $next_key = sprintf('%04d', $next_id);
302: while (exists $ids{$next_key}) {
303: $next_id++;
304: $next_key = sprintf('%04d', $next_id);
305: }
1.1 andrew 306:
1.3 andrew 307: return $next_id;
1.1 andrew 308: }
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