Compare commits
No commits in common. "master" and "0.1.0" have entirely different histories.
|
|
@ -1,37 +0,0 @@
|
|||
# ---> Perl
|
||||
!Build/
|
||||
.last_cover_stats
|
||||
/META.yml
|
||||
/META.json
|
||||
/MYMETA.*
|
||||
*.o
|
||||
*.pm.tdy
|
||||
*.bs
|
||||
|
||||
# Devel::Cover
|
||||
cover_db/
|
||||
|
||||
# Devel::NYTProf
|
||||
nytprof.out
|
||||
|
||||
# Dizt::Zilla
|
||||
/.build/
|
||||
|
||||
# Module::Build
|
||||
_build/
|
||||
Build
|
||||
Build.bat
|
||||
|
||||
# Module::Install
|
||||
inc/
|
||||
|
||||
# ExtUitls::MakeMaker
|
||||
/blib/
|
||||
/_eumm/
|
||||
/*.gz
|
||||
/Makefile
|
||||
/Makefile.old
|
||||
/MANIFEST.bak
|
||||
/pm_to_blib
|
||||
/*.zip
|
||||
|
||||
|
|
@ -0,0 +1 @@
|
|||
WPA-CLI/
|
||||
40
LICENSE
40
LICENSE
|
|
@ -1,40 +0,0 @@
|
|||
LICENSE AND COPYRIGHT
|
||||
|
||||
Copyright (C) 2018 Zane C. Bowers-Hadley
|
||||
|
||||
This program is free software; you can redistribute it and/or modify it
|
||||
under the terms of the the Artistic License (2.0). You may obtain a
|
||||
copy of the full license at:
|
||||
|
||||
L<http://www.perlfoundation.org/artistic_license_2_0>
|
||||
|
||||
Any use, modification, and distribution of the Standard or Modified
|
||||
Versions is governed by this Artistic License. By using, modifying or
|
||||
distributing the Package, you accept this license. Do not use, modify,
|
||||
or distribute the Package, if you do not accept this license.
|
||||
|
||||
If your Modified Version has been derived from a Modified Version made
|
||||
by someone other than you, you are nevertheless required to ensure that
|
||||
your Modified Version complies with the requirements of this license.
|
||||
|
||||
This license does not grant you the right to use any trademark, service
|
||||
mark, tradename, or logo of the Copyright Holder.
|
||||
|
||||
This license includes the non-exclusive, worldwide, free-of-charge
|
||||
patent license to make, have made, use, offer to sell, sell, import and
|
||||
otherwise transfer the Package with respect to any patent claims
|
||||
licensable by the Copyright Holder that are necessarily infringed by the
|
||||
Package. If you institute patent litigation (including a cross-claim or
|
||||
counterclaim) against any party alleging that the Package constitutes
|
||||
direct or contributory patent infringement, then this Artistic License
|
||||
to you shall terminate on the date that such litigation is filed.
|
||||
|
||||
Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
|
||||
AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
|
||||
THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
|
||||
PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
|
||||
YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
|
||||
CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
|
||||
CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
|
||||
EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
|
||||
|
|
@ -1,37 +0,0 @@
|
|||
Revision history for Net-Wireless-802_11-WPA-CLI
|
||||
|
||||
2.1.0 2018-?-?/?:?
|
||||
- POD formatting cleanup.
|
||||
|
||||
2.1.0 2011-08-19/06:00
|
||||
-Add missing dependency to Makefile.PL.
|
||||
-POD cleanup.
|
||||
-get_network no longer removes quotes
|
||||
-Add the methods below.
|
||||
bss
|
||||
scan
|
||||
scan_results
|
||||
get_capability
|
||||
|
||||
2.0.2 2011-08-18/10:40
|
||||
-list_networks now properly parses the returned data.
|
||||
|
||||
2.0.1 2011-08-18/10:10
|
||||
-Fix some initialization errors and issues with status_breakdown.
|
||||
|
||||
2.0.0 2011-08-18/08:15
|
||||
-Now uses Error::Helper.
|
||||
-Allows for a control socket to be specified.
|
||||
-Now depends on shell_quote.
|
||||
-Lots of cleanup in regards to error handling.
|
||||
|
||||
1.0.0 2011-08-16/03:05
|
||||
-Rename to Net::Wireless::802_11::WPA::CLI.
|
||||
|
||||
0.1.1 2011-07-01/18:10
|
||||
-Fix POD issues.
|
||||
-Update name post marriage.
|
||||
-Minor cleanups.
|
||||
|
||||
0.1.0 2008-04-06/19:00
|
||||
-Initial release.
|
||||
|
|
@ -1,18 +0,0 @@
|
|||
use strict;
|
||||
use warnings;
|
||||
use ExtUtils::MakeMaker;
|
||||
|
||||
WriteMakefile(
|
||||
NAME => 'Net::Wireless::802_11::WPA::CLI',
|
||||
AUTHOR => 'Zane C. Bowers-Hadley <vvelox@vvelox.net>',
|
||||
VERSION_FROM => 'lib/Net/Wireless/802_11/WPA/CLI.pm',
|
||||
ABSTRACT_FROM => 'lib/Net/Wireless/802_11/WPA/CLI.pm',
|
||||
PL_FILES => {},
|
||||
PREREQ_PM => {
|
||||
'Test::More' => 0,
|
||||
'Error::Helper'=>0,
|
||||
'String::ShellQuote'=>0,
|
||||
},
|
||||
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
|
||||
clean => { FILES => 'Net-Wireless-802_11-WPA-CLI-*' },
|
||||
);
|
||||
File diff suppressed because it is too large
Load Diff
|
|
@ -1,9 +0,0 @@
|
|||
#!perl -T
|
||||
|
||||
use Test::More tests => 1;
|
||||
|
||||
BEGIN {
|
||||
use_ok( 'Net::Wireless::802_11::WPA::CLI' );
|
||||
}
|
||||
|
||||
diag( "Testing Net::Wireless::802_11::WPA::CLI $Net::Wireless::802_11::WPA::CLI::VERSION, Perl $], $^X" );
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
Revision history for WPA-CLI
|
||||
|
||||
0.1.0 2008-04-06/19:00
|
||||
Initial release.
|
||||
|
|
@ -2,7 +2,7 @@ Changes
|
|||
MANIFEST
|
||||
Makefile.PL
|
||||
README
|
||||
lib/Net/Wireless/802_11/WPA/CLI.pm
|
||||
lib/WPA/CLI.pm
|
||||
t/00-load.t
|
||||
t/pod-coverage.t
|
||||
t/pod.t
|
||||
|
|
@ -0,0 +1,16 @@
|
|||
use strict;
|
||||
use warnings;
|
||||
use ExtUtils::MakeMaker;
|
||||
|
||||
WriteMakefile(
|
||||
NAME => 'WPA::CLI',
|
||||
AUTHOR => 'Zane C. Bowers <vvelox@vvelox.net>',
|
||||
VERSION_FROM => 'lib/WPA/CLI.pm',
|
||||
ABSTRACT_FROM => 'lib/WPA/CLI.pm',
|
||||
PL_FILES => {},
|
||||
PREREQ_PM => {
|
||||
'Test::More' => 0,
|
||||
},
|
||||
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
|
||||
clean => { FILES => 'WPA-CLI-*' },
|
||||
);
|
||||
|
|
@ -1,10 +1,8 @@
|
|||
Net-Wireless-802_11-WPA-CLI
|
||||
WPA-CLI
|
||||
|
||||
This is a module for making use of wpa_cli for controlling
|
||||
wpa_supplicant.
|
||||
|
||||
This module was originally named 'WPA::CLI', but was renamed
|
||||
to bring it inline with some other stuff I've been working on.
|
||||
|
||||
INSTALLATION
|
||||
|
||||
|
|
@ -20,26 +18,26 @@ SUPPORT AND DOCUMENTATION
|
|||
After installing, you can find documentation for this module with the
|
||||
perldoc command.
|
||||
|
||||
perldoc Net::Wireless::802_11::WPA::CLI
|
||||
perldoc WPA::CLI
|
||||
|
||||
You can also look for information at:
|
||||
|
||||
RT, CPAN's request tracker
|
||||
http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-Wireless-802_11-WPA-CLI
|
||||
http://rt.cpan.org/NoAuth/Bugs.html?Dist=WPA-CLI
|
||||
|
||||
AnnoCPAN, Annotated CPAN documentation
|
||||
http://annocpan.org/dist/Net-Wireless-802_11-WPA-CLI
|
||||
http://annocpan.org/dist/WPA-CLI
|
||||
|
||||
CPAN Ratings
|
||||
http://cpanratings.perl.org/d/Net-Wireless-802_11-WPA-CLI
|
||||
http://cpanratings.perl.org/d/WPA-CLI
|
||||
|
||||
Search CPAN
|
||||
http://search.cpan.org/dist/Net-Wireless-802_11-WPA-CLI
|
||||
http://search.cpan.org/dist/WPA-CLI
|
||||
|
||||
|
||||
COPYRIGHT AND LICENCE
|
||||
|
||||
Copyright (C) 2011 Zane C. Bowers-Hadley
|
||||
Copyright (C) 2008 Zane C. Bowers
|
||||
|
||||
This program is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
|
@ -0,0 +1,684 @@
|
|||
package WPA::CLI;
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
WPA::CLI - The great new WPA::CLI!
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
Version 0.1.0
|
||||
|
||||
=cut
|
||||
|
||||
our $VERSION = '0.1.0';
|
||||
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use WPA::CLI;
|
||||
|
||||
my $foo = WPA::CLI->new();
|
||||
...
|
||||
|
||||
=head1 FUNCTIONS
|
||||
|
||||
=head2 new
|
||||
|
||||
This initializes the object to be used for making use of wpa_cli.
|
||||
|
||||
It takes no arguements and returns undef upon failure.
|
||||
|
||||
=cut
|
||||
|
||||
sub new {
|
||||
#tests if it is usable.
|
||||
my $status=`wpa_cli status`;
|
||||
if (!$? == 0){
|
||||
warn("wpa_cli failed with '".$status."'");
|
||||
return undef;
|
||||
};
|
||||
|
||||
my %statusH=status_breakdown($status);
|
||||
if (!defined($status)){
|
||||
return undef;
|
||||
};
|
||||
|
||||
my $self = {status=>{%statusH}};
|
||||
|
||||
|
||||
bless $self;
|
||||
|
||||
bless $self;
|
||||
return $self;
|
||||
}
|
||||
|
||||
=head2 status
|
||||
|
||||
This function gets the current status from wpa_cli.
|
||||
|
||||
It takes no arguements and returns undef upon failure.
|
||||
|
||||
=cut
|
||||
|
||||
sub status{
|
||||
my ($self, $statusS)= @_;
|
||||
|
||||
my $status=`wpa_cli status`;
|
||||
if (!$? == 0){
|
||||
warn("wpa_cli failed with '".$status."'");
|
||||
return undef;
|
||||
};
|
||||
|
||||
my %statusH=status_breakdown($status);
|
||||
if (!defined($status)){
|
||||
return undef;
|
||||
};
|
||||
|
||||
$self->{status}={%statusH};
|
||||
|
||||
return %statusH;
|
||||
};
|
||||
|
||||
=head2 save_config
|
||||
|
||||
This saves the current configuration. The user requesting this
|
||||
does not need write permissions to file being used
|
||||
|
||||
It takes no arguements and returns undef upon failure.
|
||||
|
||||
=cut
|
||||
|
||||
sub save_config{
|
||||
my ($self)= @_;
|
||||
|
||||
return $self->run_TF_command('save_config');
|
||||
};
|
||||
|
||||
=head2 reassociate
|
||||
|
||||
This saves the current configuration. The user requesting this
|
||||
does not need write permissions to file being used
|
||||
|
||||
It takes no arguements and returns undef upon failure.
|
||||
|
||||
=cut
|
||||
|
||||
sub reassociate{
|
||||
my ($self)= @_;
|
||||
|
||||
return $self->run_TF_command('reassociate');
|
||||
};
|
||||
|
||||
=head2 set_network
|
||||
|
||||
$return=$obj->set_network($networkID, $variable, $value)
|
||||
|
||||
This sets a variable for for a specific network ID.
|
||||
|
||||
The return of undef indicates a error with running wpa_cli, other wise
|
||||
it is a true or false for if it worked.
|
||||
|
||||
=cut
|
||||
|
||||
sub set_network{
|
||||
my ($self, $nid, $variable, $value)= @_;
|
||||
|
||||
#return if the netword ID is not numeric.
|
||||
if ($nid =~ /[0123456789]*/){
|
||||
warn('non-numeric network ID used');
|
||||
return undef;
|
||||
};
|
||||
|
||||
return $self->run_TF_command('set_network '.$nid.' '.$variable.' '.$value, 0);
|
||||
};
|
||||
|
||||
=head2 get_network
|
||||
|
||||
$return=$obj->get_network($networkID, $variable)
|
||||
|
||||
This gets a variable for for a specific network ID.
|
||||
|
||||
The return of undef indicates a error with running wpa_cli or a failure
|
||||
is returned. Otherwise it is what ever the variable was set to.
|
||||
|
||||
=cut
|
||||
|
||||
sub get_network{
|
||||
my ($self, $nid, $variable)= @_;
|
||||
|
||||
#return if the netword ID is not numeric.
|
||||
if ($nid =~ /[0123456789]*/){
|
||||
warn('non-numeric network ID used');
|
||||
return undef;
|
||||
};
|
||||
|
||||
my $returned=$self->run_command('get_network '.$nid.' '.$variable);
|
||||
|
||||
#this means there was a error running wpa_cli
|
||||
if(!defined($returned)){
|
||||
return undef;
|
||||
};
|
||||
|
||||
#this means it failed
|
||||
if ($returned =~ /.*\nFAIL\n/){
|
||||
return undef;
|
||||
};
|
||||
|
||||
#remove the first line.
|
||||
$returned=~s/.*\n//;
|
||||
|
||||
#remove ^" and "$, which will be useful for SSID and possibly some others.
|
||||
$returned=~s/^"//;
|
||||
$returned=~s/^#//;
|
||||
|
||||
return $returned;
|
||||
};
|
||||
|
||||
=head2 pin
|
||||
|
||||
$return=$obj->pin($networkID, $value)
|
||||
|
||||
This sets the pin for a network.
|
||||
|
||||
The return of undef indicates a error with running wpa_cli or non-numeric
|
||||
network ID, other wise it is a true or false for if it worked.
|
||||
|
||||
=cut
|
||||
|
||||
sub pin{
|
||||
my ($self, $nid, $value)= @_;
|
||||
|
||||
#return if the netword ID is not numeric.
|
||||
if ($nid =~ /[0123456789]*/){
|
||||
warn('non-numeric network ID used');
|
||||
return undef;
|
||||
};
|
||||
|
||||
return $self->run_TF_command('pin '.$nid.' '.$value, 0);
|
||||
};
|
||||
|
||||
=head2 new_password
|
||||
|
||||
$return=$obj->new_password($networkID, $value)
|
||||
|
||||
This sets a new password for a network.
|
||||
|
||||
The return of undef indicates a error with running wpa_cli or non-numeric
|
||||
network ID, other wise it is a true or false for if it worked.
|
||||
|
||||
=cut
|
||||
|
||||
sub new_password{
|
||||
my ($self, $nid, $value)= @_;
|
||||
|
||||
#return if the netword ID is not numeric.
|
||||
if ($nid =~ /[0123456789]*/){
|
||||
warn('non-numeric network ID used');
|
||||
return undef;
|
||||
};
|
||||
|
||||
return $self->run_TF_command('new_password '.$nid.' '.$value, 0);
|
||||
};
|
||||
|
||||
=head2 add_network
|
||||
|
||||
$return=$obj->add_network()
|
||||
|
||||
This adds a network.
|
||||
|
||||
The returned value is the numeric ID of the new network. A
|
||||
return of UNDEF indicates some error.
|
||||
|
||||
=cut
|
||||
|
||||
sub add_network{
|
||||
my ($self)= @_;
|
||||
|
||||
|
||||
my $returned=$self->run_command('add_network');
|
||||
|
||||
#this means there was a error running wpa_cli
|
||||
if(!defined($returned)){
|
||||
return undef;
|
||||
};
|
||||
|
||||
#this means it failed
|
||||
if ($returned =~ /.*\nFAIL\n/){
|
||||
return undef;
|
||||
};
|
||||
|
||||
#remove the first line.
|
||||
$returned=~s/.*\n//;
|
||||
|
||||
chomp($returned);
|
||||
|
||||
return $returned;
|
||||
};
|
||||
|
||||
=head2 remove_network
|
||||
|
||||
$return=$obj->remove_network($networkID)
|
||||
|
||||
This sets a one-time-password a network.
|
||||
|
||||
The return of undef indicates a error with running wpa_cli or
|
||||
non-numeric network ID, other wise it is a true or false for if
|
||||
it worked.
|
||||
|
||||
=cut
|
||||
|
||||
sub remove_network{
|
||||
my ($self, $nid)= @_;
|
||||
|
||||
#return if the netword ID is not numeric.
|
||||
if ($nid =~ /[0123456789]*/){
|
||||
warn('non-numeric network ID used');
|
||||
return undef;
|
||||
};
|
||||
|
||||
return $self->run_TF_command('remove_network '.$nid, 0);
|
||||
};
|
||||
|
||||
=head2 select_network
|
||||
|
||||
$return=$obj->select_network($networkID)
|
||||
|
||||
This is the network ID to select, while disabling the others.
|
||||
|
||||
The return of undef indicates a error with running wpa_cli or
|
||||
a non-numeric network ID, other wise it is a true or false for
|
||||
if it worked.
|
||||
|
||||
=cut
|
||||
|
||||
sub select_network{
|
||||
my ($self, $nid)= @_;
|
||||
|
||||
#return if the netword ID is not numeric.
|
||||
if ($nid =~ /[0123456789]*/){
|
||||
warn('non-numeric network ID used');
|
||||
return undef;
|
||||
};
|
||||
|
||||
return $self->run_TF_command('select_network '.$nid, 0);
|
||||
};
|
||||
|
||||
=head2 enable_network
|
||||
|
||||
$return=$obj->enable_network($networkID)
|
||||
|
||||
This enables a network ID.
|
||||
|
||||
The return of undef indicates a error with running wpa_cli or
|
||||
a non-numeric network ID, other wise it is a true or false for
|
||||
if it worked.
|
||||
|
||||
=cut
|
||||
|
||||
sub enable_network{
|
||||
my ($self, $nid)= @_;
|
||||
|
||||
#return if the netword ID is not numeric.
|
||||
if ($nid =~ /[0123456789]*/){
|
||||
warn('non-numeric network ID used');
|
||||
return undef;
|
||||
};
|
||||
|
||||
return $self->run_TF_command('enable_network '.$nid, 0);
|
||||
};
|
||||
|
||||
=head2 disable_network
|
||||
|
||||
$return=$obj->disable_network($networkID)
|
||||
|
||||
This disables a network ID.
|
||||
|
||||
The return of undef indicates a error with running wpa_cli or
|
||||
a non-numeric network ID, other wise it is a true or false for
|
||||
if it worked.
|
||||
|
||||
=cut
|
||||
|
||||
sub disable_network{
|
||||
my ($self, $nid)= @_;
|
||||
|
||||
#return if the netword ID is not numeric.
|
||||
if ($nid =~ /[0123456789]*/){
|
||||
warn('non-numeric network ID used');
|
||||
return undef;
|
||||
};
|
||||
|
||||
return $self->run_TF_command('disable_network '.$nid, 0);
|
||||
};
|
||||
|
||||
=head2 reconfigure
|
||||
|
||||
$return=$obj->reconfigure($networkID)
|
||||
|
||||
This causes wpa_supplicant to reread it's configuration file.
|
||||
|
||||
The return of undef indicates a error with running wpa_cli,
|
||||
other wise it is a true or false for if it worked.
|
||||
|
||||
=cut
|
||||
|
||||
sub reconfigure{
|
||||
my ($self)= @_;
|
||||
|
||||
|
||||
return $self->run_TF_command('reconfigure', 0);
|
||||
};
|
||||
|
||||
=head2 preauthenticate
|
||||
|
||||
$return=$obj->preauthenticate($BSSID)
|
||||
|
||||
Force preauthentication for a BSSID.
|
||||
|
||||
The return of undef indicates a error with running wpa_cli or
|
||||
a non-numeric network ID, other wise it is a true or false for
|
||||
if it worked.
|
||||
|
||||
=cut
|
||||
|
||||
sub preauthenticate{
|
||||
my ($self, $bssid)= @_;
|
||||
|
||||
return $self->run_TF_command('preauthenticate '.$bssid, 0);
|
||||
};
|
||||
|
||||
=head2 preauthenticate
|
||||
|
||||
$return=$obj->disconnect()
|
||||
|
||||
Disconnect and wait for a reassosiate command.
|
||||
|
||||
The return of undef indicates a error with running wpa_cli or
|
||||
a non-numeric network ID, other wise it is a true or false for
|
||||
if it worked.
|
||||
|
||||
=cut
|
||||
|
||||
sub disconnect{
|
||||
my ($self, $bssid)= @_;
|
||||
|
||||
return $self->run_TF_command('disconnect'. 0);
|
||||
};
|
||||
|
||||
=head2 list_network
|
||||
|
||||
%return=$obj->get_network($networkID, $variable)
|
||||
|
||||
This lists the configured networks.
|
||||
|
||||
The return of undef indicates a error with running wpa_cli or a failure
|
||||
is returned. Otherwise a hash is returned.
|
||||
|
||||
They keys for the hash are the network IDs. The value of each is another hash.
|
||||
It contians the SSID, BSSID, and flag. All keys are lower case.
|
||||
|
||||
=cut
|
||||
|
||||
sub list_network{
|
||||
my ($self, $nid, $variable)= @_;
|
||||
|
||||
#return if the netword ID is not numeric.
|
||||
if ($nid =~ /[0123456789]*/){
|
||||
warn('non-numeric network ID used');
|
||||
return undef;
|
||||
};
|
||||
|
||||
my $returned=$self->run_command('list_network');
|
||||
|
||||
#this means there was a error running wpa_cli
|
||||
if(!defined($returned)){
|
||||
return undef;
|
||||
};
|
||||
|
||||
#this means it failed
|
||||
if ($returned =~ /.*\nFAIL\n/){
|
||||
return undef;
|
||||
};
|
||||
|
||||
my @returnedA=split(/\n/, $returned);
|
||||
|
||||
#this will be returned
|
||||
my %hash=();
|
||||
|
||||
my $returnedAint=2;
|
||||
while(defined($returnedA[$returnedAint])){
|
||||
#remove the extra spaces
|
||||
$returnedA[$returnedAint]=~s/ //g;
|
||||
|
||||
chomp($returnedA[$returnedAint]);
|
||||
|
||||
my @linesplit=split(/ /, $returnedA[$returnedAint]);
|
||||
|
||||
#finally do something with the hash
|
||||
$hash{$linesplit[0]}={flag=>$linesplit[$#linesplit]};
|
||||
|
||||
#get the bssid
|
||||
my $bssidInt=$#linesplit-1;
|
||||
$hash{$linesplit[0]}{bssid}=$linesplit[$bssidInt];
|
||||
|
||||
#rebuild the ssid part
|
||||
my $ssidInt=1;
|
||||
my $ssidIntMax=$bssidInt-1;
|
||||
$hash{$linesplit[$linesplit[0]]}{ssid}="";
|
||||
while($ssidInt <= $ssidIntMax){
|
||||
$hash{$linesplit[$linesplit[0]]}{ssid}=
|
||||
$hash{$linesplit[$linesplit[0]]}{ssid}.$linesplit[$ssidInt];
|
||||
|
||||
$ssidInt++;
|
||||
};
|
||||
};
|
||||
|
||||
return %hash;
|
||||
};
|
||||
|
||||
=head2 mib
|
||||
|
||||
%return=$obj->get_network($networkID, $variable)
|
||||
|
||||
This lists the configured networks.
|
||||
|
||||
The return of undef indicates a error with running wpa_cli or a failure
|
||||
is returned. Otherwise a hash is returned.
|
||||
|
||||
They keys for the hash are the network IDs. The value of each is another hash.
|
||||
It contians the SSID, BSSID, and flag. All keys are lower case.
|
||||
|
||||
=cut
|
||||
|
||||
sub mib{
|
||||
my ($self, $nid, $variable)= @_;
|
||||
|
||||
#return if the netword ID is not numeric.
|
||||
if ($nid =~ /[0123456789]*/){
|
||||
warn('non-numeric network ID used');
|
||||
return undef;
|
||||
};
|
||||
|
||||
my $returned=$self->run_command('mib');
|
||||
|
||||
#this means there was a error running wpa_cli
|
||||
if(!defined($returned)){
|
||||
return undef;
|
||||
};
|
||||
|
||||
#this means it failed
|
||||
if ($returned =~ /.*\nFAIL\n/){
|
||||
return undef;
|
||||
};
|
||||
|
||||
my %hash=status_breakdown($returned, 'mib');
|
||||
|
||||
return %hash;
|
||||
};
|
||||
=head2 run_TF_command
|
||||
|
||||
$returned=$obj->run_TF_command($command, 0)
|
||||
|
||||
This runs a arbirary command in which the expected values are
|
||||
either 'FAIL' or 'OK'. This function is largely intended for internal
|
||||
use by this module.
|
||||
|
||||
It takes two arguement. The first is string containing the command and any
|
||||
arguements for it. The second is what to return on a unknown return.
|
||||
|
||||
UNDEF is returned upon with running wpa_cli. Other wise a per boolean value
|
||||
is returned set to the corresponding success of the command.
|
||||
|
||||
=cut
|
||||
|
||||
sub run_TF_command{
|
||||
my ($self, $command, $onend)= @_;
|
||||
|
||||
my $status=`wpa_cli $command`;
|
||||
if (!$? == 0){
|
||||
warn("wpa_cli failed with '".$status."'"."for '".$command."'");
|
||||
return undef;
|
||||
};
|
||||
|
||||
#return 0 upon failure
|
||||
if ($status =~ /.*\nFAIL\n/){
|
||||
return 0;
|
||||
};
|
||||
|
||||
#return 1 upon success
|
||||
if ($status =~ /.*\nOK\n/){
|
||||
return 1;
|
||||
};
|
||||
|
||||
return $onend;
|
||||
};
|
||||
|
||||
=head2 run_command
|
||||
|
||||
$returned=$obj->run_command($command)
|
||||
|
||||
This runs a arbirary command in which. This function is largely intended for
|
||||
internal use by this module.
|
||||
|
||||
It takes arguement, which is string containing the command and any
|
||||
arguements for it.
|
||||
|
||||
UNDEF is returned upon with running wpa_cli. Otherwise the return is the return
|
||||
from executed command.
|
||||
|
||||
=cut
|
||||
|
||||
sub run_command{
|
||||
my ($self, $command)= @_;
|
||||
|
||||
my $status=`wpa_cli $command`;
|
||||
if (!$? == 0){
|
||||
warn("wpa_cli failed with '".$status."'"."for '".$command."'");
|
||||
return undef;
|
||||
};
|
||||
|
||||
return $status;
|
||||
};
|
||||
|
||||
#this is a internal function used by this module
|
||||
#It breaks down that return from status.
|
||||
sub status_breakdown{
|
||||
my ($statusS, $type)= @_;
|
||||
|
||||
my %hash=();
|
||||
|
||||
my @statusA=split(/\n/, $statusS);
|
||||
|
||||
if (!defined($type)){
|
||||
$type="status"
|
||||
};
|
||||
|
||||
if (! $statusA[0] =~ /^Selected interface/){
|
||||
warn("Unexpected return from 'wpa_cli ".$type."': ".$statusA[0]);
|
||||
return undef;
|
||||
};
|
||||
|
||||
my @interfaceA=split(/\'/, $statusA[0]);
|
||||
|
||||
$hash{interface}=$interfaceA[1];
|
||||
|
||||
my $statusAint=1;
|
||||
while(defined($statusA[$statusAint])){
|
||||
chomp($statusA[$statusAint]);
|
||||
my @linesplit=split(/=/, $statusA[$statusAint]);
|
||||
$hash{$linesplit[0]}=$linesplit[1];
|
||||
|
||||
$statusAint++;
|
||||
};
|
||||
|
||||
return %hash;
|
||||
};
|
||||
|
||||
=head1 NOTES
|
||||
|
||||
This makes use of wpa_cli in a non-interactive form. This means that
|
||||
interface and otp are not usable.
|
||||
|
||||
Better documentation and etc shall be coming shortly. Publishing this and starting work
|
||||
on something that uses it in it's current form.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Zane C. Bowers, C<< <vvelox at vvelox.net> >>
|
||||
|
||||
=head1 BUGS
|
||||
|
||||
Please report any bugs or feature requests to C<bug-wpa-cli at rt.cpan.org>, or through
|
||||
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=WPA-CLI>. I will be notified, and then you'll
|
||||
automatically be notified of progress on your bug as I make changes.
|
||||
|
||||
|
||||
|
||||
|
||||
=head1 SUPPORT
|
||||
|
||||
You can find documentation for this module with the perldoc command.
|
||||
|
||||
perldoc WPA::CLI
|
||||
|
||||
|
||||
You can also look for information at:
|
||||
|
||||
=over 4
|
||||
|
||||
=item * RT: CPAN's request tracker
|
||||
|
||||
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=WPA-CLI>
|
||||
|
||||
=item * AnnoCPAN: Annotated CPAN documentation
|
||||
|
||||
L<http://annocpan.org/dist/WPA-CLI>
|
||||
|
||||
=item * CPAN Ratings
|
||||
|
||||
L<http://cpanratings.perl.org/d/WPA-CLI>
|
||||
|
||||
=item * Search CPAN
|
||||
|
||||
L<http://search.cpan.org/dist/WPA-CLI>
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 ACKNOWLEDGEMENTS
|
||||
|
||||
|
||||
=head1 COPYRIGHT & LICENSE
|
||||
|
||||
Copyright 2008 Zane C. Bowers, all rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
|
||||
=cut
|
||||
|
||||
1; # End of WPA::CLI
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
#!perl -T
|
||||
|
||||
use Test::More tests => 1;
|
||||
|
||||
BEGIN {
|
||||
use_ok( 'WPA::CLI' );
|
||||
}
|
||||
|
||||
diag( "Testing WPA::CLI $WPA::CLI::VERSION, Perl $], $^X" );
|
||||
|
|
@ -48,7 +48,7 @@ TODO: {
|
|||
"placeholder date/time" => qr(Date/time)
|
||||
);
|
||||
|
||||
module_boilerplate_ok('lib/Net/Wireless/802_11/WPA/CLI.pm');
|
||||
module_boilerplate_ok('lib/WPA/CLI.pm');
|
||||
|
||||
|
||||
}
|
||||
Loading…
Reference in New Issue