installed_progs.t: Python checks stdout too, 150 ok
[sunny256-utils.git] / wlan-list
blob661ce71fb95b5e761bb17aa2ed5aa1090ff31a19
1 #!/usr/bin/env perl
3 #=======================================================================
4 # wlan-list
5 # File ID: 4e1b3802-f744-11dd-92f4-000475e441b9
6 # Latskap.
8 # Character set: UTF-8
9 # ©opyleft 2006– Øyvind A. Holm <sunny@sunbase.org>
10 # License: GNU General Public License version 2 or later, see end of
11 # file for legal stuff.
12 #=======================================================================
14 use strict;
15 use warnings;
16 use Getopt::Long;
18 $| = 1;
20 our $Debug = 0;
22 our %Opt = (
24 'debug' => 0,
25 'encrypted' => 0,
26 'help' => 0,
27 'verbose' => 0,
28 'version' => 0,
29 'xml' => 0,
33 our $progname = $0;
34 $progname =~ s/^.*\/(.*?)$/$1/;
35 our $VERSION = "0.00";
37 Getopt::Long::Configure("bundling");
38 GetOptions(
40 "debug" => \$Opt{'debug'},
41 "encrypted|e" => \$Opt{'encrypted'},
42 "help|h" => \$Opt{'help'},
43 "verbose|v+" => \$Opt{'verbose'},
44 "version" => \$Opt{'version'},
45 "xml|x" => \$Opt{'xml'},
47 ) || die("$progname: Option error. Use -h for help.\n");
49 $Opt{'debug'} && ($Debug = 1);
50 $Opt{'help'} && usage(0);
51 if ($Opt{'version'}) {
52 print_version();
53 exit(0);
56 if ($Opt{'verbose'}) {
57 system("iwlist ath0 scan | less");
58 } elsif ($Opt{'encrypted'}) {
59 system("iwlist ath0 scan | egrep '(Address:|ESSID:|Quality=|Encryption)' | perl -pe 's/(Encryption key:off)/\x1B[1m$1\x1B[m/g;'");
60 } elsif ($Opt{'xml'}) {
61 my $found_cell = 0;
62 if (open(PipeFP, "iwlist ath0 scan |")) {
63 print("<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<wlan>\n");
64 my $curr_time = time();
65 my ($Sec, $Min, $Hour, $Day, $Mon, $Year, $Wday, $Yday) = gmtime($curr_time);
66 $Sec = sprintf("%02u", $Sec);
67 $Min = sprintf("%02u", $Min);
68 $Hour = sprintf("%02u", $Hour);
69 $Day = sprintf("%02u", $Day);
70 $Mon = sprintf("%02u", $Mon + 1);
71 $Year = sprintf("%04u", $Year + 1900);
73 my $Date = "$Year-$Mon-${Day}T$Hour:$Min:${Sec}Z";
74 my $end_cell = " </cell>\n";
75 my $First = 1;
76 while (<PipeFP>) {
77 chomp(my $Line = $_);
78 D("\$Line = '$Line'");
79 $Line =~ s/^ +//;
80 $Line =~ s/^(\S+)\s+Scan completed :/sprintf(" <device>%s<\/device>\n <date>$Date<\/date>", txt_to_xml($1))/e;
81 if (
82 $Line =~ s{^Cell (\d+) - Address: (\S+)$}
84 my $Tmp = $First ? "" : $end_cell;
85 $Tmp .= sprintf(
86 " <cell num=\"%s\">\n <macaddr>%s<\/macaddr>",
87 txt_to_xml($1), txt_to_xml($2)
89 $Tmp;
91 ) {
92 $found_cell = 1;
93 if ($First) {
94 $First = 0;
97 $Line =~ s/^ESSID:"(.*)"$/sprintf(" <essid>$1<\/essid>")/e;
98 $Line =~ s/^Mode:(.*)$/sprintf(" <mode>$1<\/mode>")/e;
99 $Line =~ s{^
100 Frequency:(\S+)\ (\S+)\ \(Channel\ (\d+)\)$
102 sprintf(
103 " <freq unit=\"%s\">%s<\/freq>\n <channel>%s<\/channel>",
104 txt_to_xml($2), txt_to_xml($1), txt_to_xml($3)
106 }ex;
107 $Line =~ s{^
108 Quality=(\S+)\s+
109 Signal\ level=(\S+)\ (\S+)\s+
110 Noise\ level=(\S+)\ (\S+)
113 sprintf(
114 " <quality>%s</quality>\n <signallevel unit=\"%s\">%s</signallevel>\n <noiselevel unit=\"%s\">%s</noiselevel>",
115 txt_to_xml($1), txt_to_xml($3), txt_to_xml($2), txt_to_xml($5), txt_to_xml($4)
117 }ex;
118 $Line =~ s/Encryption key:(on|off)$/ <encryption>$1<\/encryption>/;
119 $Line =~ s/^Bit Rate:(\S+) (\S+)$/sprintf(" <rate unit=\"%s\">%s<\/rate>", txt_to_xml($2), txt_to_xml($1))/e;
120 $Line =~ s/^Extra:([a-z_]+)=(.*)$/sprintf(" <extra name=\"%s\">%s<\/extra>", txt_to_xml($1), txt_to_xml($2))/e;
121 length($Line) && print("$Line\n");
123 close(PipeFP);
124 $found_cell && print($end_cell);
125 } else {
126 warn("$progname: Unable to open pipe: $!");
128 print("</wlan>\n");
129 } else {
130 system("wlanconfig ath0 list scan");
133 sub print_version {
134 # Print program version {{{
135 print("$progname v$VERSION\n");
136 # }}}
137 } # print_version()
139 sub usage {
140 # Send the help message to stdout {{{
141 my $Retval = shift;
143 if ($Opt{'verbose'}) {
144 print("\n");
145 print_version();
147 print(<<END);
149 List available wireless networks.
151 Usage: $progname [options] [file [files [...]]]
153 Options:
155 -e, --encrypted
156 List networks on a more terse format with encryption info.
157 -h, --help
158 Show this help.
159 -v, --verbose
160 Show verbose info about the networks. Can be repeated to increase
161 verbosity level.
162 -x, --xml
163 Create XML output.
164 --version
165 Print version information.
166 --debug
167 Print debugging messages.
170 exit($Retval);
171 # }}}
172 } # usage()
174 sub msg {
175 # Print a status message to stderr based on verbosity level {{{
176 my ($verbose_level, $Txt) = @_;
178 if ($Opt{'verbose'} >= $verbose_level) {
179 print(STDERR "$progname: $Txt\n");
181 # }}}
182 } # msg()
184 sub D {
185 # Print a debugging message {{{
186 $Debug || return;
187 my @call_info = caller;
188 chomp(my $Txt = shift);
189 my $File = $call_info[1];
190 $File =~ s#\\#/#g;
191 $File =~ s#^.*/(.*?)$#$1#;
192 print(STDERR "$File:$call_info[2] $$ $Txt\n");
193 return("");
194 # }}}
195 } # D()
197 sub txt_to_xml {
198 # Convert plain text to XML {{{
199 my $Txt = shift;
200 $Txt =~ s/&/&amp;/gs;
201 $Txt =~ s/</&lt;/gs;
202 $Txt =~ s/>/&gt;/gs;
203 $Txt =~ s/"/&quot;/gs;
204 $Txt =~ s/"/&apos;/gs;
205 return($Txt);
206 # }}}
209 __END__
211 # Plain Old Documentation (POD) {{{
213 =pod
215 =head1 NAME
219 =head1 SYNOPSIS
221 [options] [file [files [...]]]
223 =head1 DESCRIPTION
227 =head1 OPTIONS
229 =over 4
231 =item B<-h>, B<--help>
233 Print a brief help summary.
235 =item B<-v>, B<--verbose>
237 Increase level of verbosity. Can be repeated.
239 =item B<--version>
241 Print version information.
243 =item B<--debug>
245 Print debugging messages.
247 =back
249 =head1 BUGS
253 =head1 AUTHOR
255 Made by Øyvind A. Holm S<E<lt>sunny@sunbase.orgE<gt>>.
257 =head1 COPYRIGHT
259 Copyleft © Øyvind A. Holm E<lt>sunny@sunbase.orgE<gt>
260 This is free software; see the file F<COPYING> for legalese stuff.
262 =head1 LICENCE
264 This program is free software: you can redistribute it and/or modify it
265 under the terms of the GNU General Public License as published by the
266 Free Software Foundation, either version 2 of the License, or (at your
267 option) any later version.
269 This program is distributed in the hope that it will be useful, but
270 WITHOUT ANY WARRANTY; without even the implied warranty of
271 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
272 See the GNU General Public License for more details.
274 You should have received a copy of the GNU General Public License along
275 with this program.
276 If not, see L<http://www.gnu.org/licenses/>.
278 =head1 SEE ALSO
280 =cut
282 # }}}
284 # vim: set fenc=UTF-8 ft=perl fdm=marker ts=4 sw=4 sts=4 et fo+=w :