File Coverage

blib/lib/Ekahau/Base.pm

Criterion	Covered	Total	%
statement	25	27	92.5
branch			n/a
condition			n/a
subroutine	9	9	100.0
pod			n/a
total	34	36	94.4

package Ekahau::Base;
our $VERSION = '0.001';

# Written by Scott Gifford
# Copyright (C) 2004 The Regents of the University of Michigan.
# See the file LICENSE included with the distribution for license
# information.

use warnings;
use strict;
use bytes; # Avoid Unicode crap

use base 'Ekahau::ErrHandler';

our $_global_last_error;

use constant DEFAULT_PORT => 8548;
use constant DEFAULT_HOST => 'localhost';
use constant READ_BLOCKSIZE => 8192;

=head1 NAME

Ekahau::Base - Low-level interface to Ekahau location sensing system

=head1 SYNOPSIS

The C class provides a low-level interface to the Ekahau
location sensing system's YAX protocol.  In general you don't want to
use this class directly; instead the subclasses L and
L provide a nicer interface.

=head1 DESCRIPTION

This class implements methods for querying the Ekahau Positioning
Engine, and processing the responses.  Each object represents a
connection to the Ekahau server.  Some methods send queries to the
server, while others receive responses.  Continuous queries generate
data until they are asked to stop, so the protocol is not strictly
request-response.  To deal with this, queries can have a "tag"
associated with them, which allows the response to that specific
command to be identified.

=cut

use Ekahau::Response;
use Ekahau::License;

use IO::Socket::INET;
use IO::Select;

=head2 Constructor

=head3 new ( [ %params ] )

The C constructor creates a new Ekahau object.  It takes a series
of parameters as arguments, in the C Value> style.  The
following parameters are recognized:

=over 4

=item Timeout

The maximum length of time to wait for a response or connection.

=item PeerAddr

The name or IP address of the Ekahau server you'd like to communicate
with.  This is passed along to the L module, and you
can use the alias C if you prefer.  It defaults to C.

=item PeerPort

The TCP port where the Ekahau server you'd like to communicate with is
running.  It defaults to C<8548>.

=item Password

The password to talk to the Ekahau server.  The default password is
C, which is what the server will use if you haven't configured
a password.

=item LicenseFile

The XML file containing your Ekahau license.  If you don't specify a
C, and anonymous connection will be used, which may be
limited by the software.

=back

=cut

sub new
{
    my $class = shift;
    my(%p) = @_;

    my $self = {};
    bless $self,$class;
    $self->{_errhandler} = Ekahau::ErrHandler->errhandler_new($class,%p);

    $self->{tag} = 0;
    $self->{_readbuf} = "";
    $self->{_timeout}=$p{Timeout}||$p{timeout};

    $self->_connect(%p)
	or return undef;
    $self->_start(%p)
	or return undef;

    $self->errhandler_constructed();
}

sub ERROBJ
{
    my $self = shift;
    $self->{_errhandler};
}

# Connect to the TCP socket
sub _connect
{
    my $self = shift;
    my(%p)=@_;
    my $sock;

    if ($p{Socket})
    {
	$sock = $p{Socket};
    }
    else
    {
	# For IO::Socket::INET
	if ($p{timeout} && !$p{Timeout})
	{
	    $p{Timeout}=$p{timeout};
	}
	elsif ($self->{_timeout})
	{
	    $p{Timeout} = $self->{_timeout};
	}

	if (!$p{PeerPort}) { $p{PeerPort} = DEFAULT_PORT };
	if (!$p{PeerAddr} and !$p{PeerHost}) { $p{PeerAddr} = DEFAULT_HOST };

	warn "DEBUG Connecting to $p{PeerAddr}:$p{PeerPort}...\n"
	    if ($ENV{VERBOSE});
	$sock = IO::Socket::INET->new(%p,
				      Proto => 'tcp')
	    or return $self->reterr("Couldn't create IO::Socket::INET -  $!");
    }

    $self->{_sock} = $sock;
    binmode $self->{_sock};
    $self->{_sock}->autoflush(1);
    $self->{_socksel} = IO::Select->new($self->{_sock})
	or return $self->reterr("Couldn't create IO::Select - $!");

    warn "DEBUG connected.\n"
	if ($ENV{VERBOSE});

    1;
}

# Start the YAX protocol, and authenticate with our license
# or anonymously
sub _start
{
    my $self = shift;
    my $talkresp;
    my(%p)=@_;

    $p{Password} ||= $p{password};
    if (!defined($p{Password})) { $p{Password}="Llama" };

    my $hello_resp = $self->nextresponse;

    my $talk_str = '';
    my($lic,$randstr);
    if ($p{LicenseFile})
    {
	# Make up a random string real quick.
	# This isn't cryptographically secure, but who cares?
	$randstr = sprintf "%02x"x8, map { int(rand(256)) } 1..8;
	# Read in the license file
	eval {
	    $lic = Ekahau::License->new(LicenseFile => $p{LicenseFile})
		or return $self->reterr("Error processing LicenseFile '$p{LicenseFile}': " . Ekahau::License->lasterr);
	};
	$@ and return $self->reterr("Error creating Ekahau::License object - $@");

	$self->command(['HELLO',1,'"'.$randstr.'"',$lic->hello_str])
	    or return undef;
        $talk_str = $lic->talk_str(Password => $p{Password}, HelloStr => $hello_resp->{args}[1])
	    or return $self->reterr("Error getting talk string from LicenseFile '$p{LicenseFile}': ".$lic->lasterr);
    }
    else
    {
	# No license file, log in anonymously
	$self->command(['HELLO',1,'""',"password=$p{Password}"])
	    or return undef;
    }
    $self->command(['TALK','yax',1,'yax1','MD5','"'.$talk_str.'"'])
	or return undef;
    $talkresp = $self->nextresponse
	or return undef;
    if ($talkresp->error)
    {
	return $self->reterr("Couldn't initiate session with Ekahau: ".$talkresp->error_description)
    }
    elsif ($talkresp->{cmd} ne 'TALK')
    {
	return $self->reterr("Couldn't initiate session with Ekahau: Unexpected response $talkresp->{string}");
    }

    if ($talkresp->{args}[0] !~ /^"?yax"?$/i)
    {
	return $self->reterr("Server is speaking unknown protocol '$talkresp->{args}[0]'");
    }
    if ($talkresp->{args}[3] !~ /^"?MD5"?/i)
    {
	return $self->reterr("Server is using unknown checksum '$talkresp->{args}[3]'");
    }

    if ($p{LicenseFile})
    {
	my $server_talk_str = $lic->talk_str(Password => $p{Password}, HelloStr => $randstr)
	    or $self->reterr("Error getting server talk string from LicenseFile: ".$lic->lasterr);
	if ($server_talk_str ne $talkresp->{args}[4])
	{
           return $self->reterr("Server gave invalid checksum");
	}
    }
    1;
}

# Read a response, taking it from the read buffer if a full response
# is available, and otherwise reading from the network.
sub _readresponse
{
    my $self = shift;
    my $r;

    while (1)
    {
	if ($r = $self->readpending) { last };
	if ($self->can_read($self->{_timeout}))
	{
	    $self->readsome();
	}
	else
	{
	    return '';
	}
    }
    $r;
}

sub _set_errhandler
{
    my $self = shift;
    my($eh)=@_;
    if ($eh)
    {
	$self->{_lasterror}=$eh;
    }
    else
    {
	$self->{_lasterror} = \$_global_last_error
    }
    $self->reterr('no error yet');
    1;
}

=head2 Methods

=head3 close ( )

Properly shut down the connection to the Ekahau engine, by sending a
C command then closing the socket.

=cut

sub close
{
    my $self = shift;
    $self->command('CLOSE')
	or return undef;
    # It's the same as an abort from here on out.
    $self->abort;
}

=head3 abort ( )

Abort the connection to the Ekahau engine, by closing the socket.

=cut

sub abort
{
    my $self = shift;

    my $close_ok = 1;

    $close_ok = CORE::close($self->{_sock});
    undef $self->{_sock};
    undef $self->{_socksel};

    $close_ok or return $self->reterr("Error closing socket: $!\n");
    1;
}

=head3 readsome ( )

Read some data from the network into the read buffer.  This is the
buffer where L gets pending events from.  This call
blocks, so if you don't want to wait for events, you should either
C on the handles returned by the L method, or
call the L method to determine if data is available to
read.

=cut

sub readsome
{
    my $self = shift;
    my $sock = $self->{_sock};

    sysread($sock,$self->{_readbuf},READ_BLOCKSIZE,length($self->{_readbuf}))
	or return $self->reterr("Error reading from socket: $!\n");
}

=head3 getpending ( )

Returns the next pending event, or C if no events are pending.
The event returned is an L object.

Pending events come from the buffer filled by L.

=cut

sub getpending
{
    my $self = shift;
    my $resp_txt = $self->_readpending()
	or return undef;
    return Ekahau::Response->parsenew($resp_txt);
}

sub _readpending
{
    my $self = shift;

    if ($self->{_readbuf} =~ /^(\s*<.*?(?)>\s*)/s)
    {
	my $msg = $1;
	# Is this an object with a size parameter?
	if ($self->{_readbuf} =~ /^\s*<[^>]*\x0asize=(\d+)[^>]*\x0adata=/sg)
	{
	    my $data_len = $1;
	    my $data_start = pos($self->{_readbuf});

	    if ((length($self->{_readbuf})-$data_start) < $data_len)
	    {
		# We don't have the whole thing.
		# This is just a warning.
		return $self->reterr('incomplete data response');
	    }
	    else
	    {
		$msg = substr($self->{_readbuf}, 0,$data_start + $data_len + 3);
	    }
	}
	warn "READ: '$msg'\n"
	    if ($ENV{VERBOSE});
	substr($self->{_readbuf},0,length($msg))='';
	# Preserve taintedness with substr(X,0,0)
	return $msg.substr($self->{_readbuf},0,0);
    }
    return $self->reterr('no complete response so far');
}

sub nextresponse
{
    my $self = shift;

    # Wait until we get something, or the timeout expires.
    my $started = time;
    while(1)
    {
	if (my $resp = $self->getpending)
	{
	    return $resp;
	}
	# See if we timed out.
	$self->can_read($self->{_timeout}? $self->{_timeout} : 0)
	    or return undef;

	$self->readsome()
	    or return undef;
    }

}

=head3 can_read ( $timeout )

Returns true if the network socket becomes readable within C<$timeout>
seconds; otherwise returns false.

=cut

sub can_read
{
    my $self = shift;

    $self->{_socksel}->can_read($_[0]||$self->{_timeout})
	or return $self->reterr("socket read timed out (probably)");
}

=head3 select_handles

Returns a list of filehandles suitable for use with C.  If
you're multiplexing I/O from this module and other sources, you can
select these filehandles for readability, then call the L
method to read the available data, and finally call L in
a loop to get all of the pending events.  Note that these handles
become selectable for read only when there is data on the network; if
multiple events come in at once (which is common), the handle will
become selectable once, and you'll have to retreive all of the events
with L; it won't be selectable again until there is more
data to read.

=cut

sub select_handles
{
    my $self = shift;

    ($self->{_sock});
}

=head3 request_device_list ( [ $props ] )

Requests a list of all devices connected to the system.  Returns the
command tag that was sent (which can be used to identify the
response).

An optional hash reference can be supplied with a list of properties.
The special property C will be used to set the command tag if
given (otherwise a tag will be generated).  Other properties will be
sent along in the Ekahau request.  Properties currently recognized
are:

=over 4

=item NETWORK.MAC

The MAC address of the device you'd like to look for, in
colon-seperated format.  For example:

  'NETWORK.MAC' => '00:E0:63:82:65:76'

=item NETWORK.IP-ADDRESS


The IP address of the device you'd like to look for, in dotted-quad
format.  For example:

  'NETWORK.IP-ADDRESS' => '10.0.0.1'

=back


=cut

sub request_device_list
{
    my $self = shift;
    my %p = ref $_[0] ? %{ (shift) } : ();
    my $tag = delete $p{Tag} || ++$self->{tag};

    $self->command('GET_DEVICE_LIST',\%p,$tag)
	or return undef;
    $tag;
}

=head3 request_device_properties ( [ $props ], $device_id )

Request the property list for device C<$device_id>.

The first parameter can be a hash reference containing additional
request properties to be sent, but none are documented by Ekahau for
this command.  The one exception is the special property C, which
will be used to set the command tag if given (otherwise a tag will be
generated).

=cut

sub request_device_properties
{
    my $self = shift;
    my %p = ref $_[0] ? %{ (shift) } : ();
    my $tag = delete $p{Tag} || ++$self->{tag};
    my($dev)=@_;

    $self->command(['GET_DEVICE_PROPERTIES', $dev],\%p,$tag)
	or return undef;
    $tag;
}

=head3 request_location_context ( [ $props ], $area_id )

Request information about logical area C<$location_id>.

The first parameter can be a hash reference containing additional
request properties to be sent, but none are documented by Ekahau for
this command.  The one exception is the special property C, which
will be used to set the command tag if given (otherwise a tag will be
generated).

=cut

sub request_location_context
{
    my $self = shift;
    my %p = ref $_[0] ? %{ (shift) } : ();
    my $tag = delete $p{Tag} || ++$self->{tag};
    my($c)=@_;

    $self->command(['GET_CONTEXT', $c],{},$tag)
	or return undef;
    $tag;
}

=head3 request_map_image ( [ $props ], $area_id )

Request a map of logical area C<$area_id>.  Returns an
L object.

=cut

sub request_map_image
{
    my $self = shift;
    my %p = ref $_[0] ? %{ (shift) } : ();
    my $tag = delete $p{Tag} || ++$self->{tag};
    my($c)=@_;

    $self->command(['GET_MAP', $c],{},$tag)
	or return undef;
    $tag;
}

=head3 request_all_areas ( )

Request information about all logical areas known to the Ekahau
engine.

=cut

sub request_all_areas
{
    my $self = shift;
    my %p = ref $_[0] ? %{ (shift) } : ();
    my $tag = delete $p{Tag} || ++$self->{tag};

    $self->command(['GET_LOGICAL_AREAS'],{},$tag)
	or return undef;
    $tag;
}

=head3 start_location_track ( [ $properties ], $device_id )

Ask the Ekahau engine to start sending location information about
device C<$device_id>.  You can get responses with L.

An optional hash reference can be supplied with a list of properties.
The special property C will be used to set the command tag if
given (otherwise a tag will be generated).  Other properties will be
sent along in the Ekahau request.  Properties currently recognized
are:

=over 4

=item EPE.WLAN_SCAN_INTERVAL

Interval at which wireless LAN devices should scan.  See documentation
for more information.

=item EPE.WLAN_SCAN_MODE

Wireless LAN scan mode.  See documentation for more information.

=item EPE.SNAP_TO_RAIL

Set to the string C to have all locations correspond to
positions on tracking rails, or C to allow any location.

=item EPE.EXPECTED_ERROR

Set to the string C if you would like an expected error
estimate, or C to avoid this calculation.

=item EPE.POSITIONING_MODE

Set to 1 for realtime positioning, or 2 for more accurate
positioining.

=item EPE.LOCATION_UPDATE_INTERVAL

How often you'd like an update on the device's position.

=back

=cut

sub start_location_track
{
    my $self = shift;
    my %p = ref $_[0] ? %{ (shift) } : ();
    my $tag = delete $p{Tag} || ++$self->{tag};
    my($dev) = @_;

    $self->command(['START_LOCATION_TRACK',$dev],\%p,$tag)
	or return undef;
    $tag;
}

=head3 request_stop_location_track ( $device_id )

Ask the Ekahau engine to stop sending location information about
device C<$device_id>.

=cut

sub request_stop_location_track
{
    my $self = shift;
    my %p = ref $_[0] ? %{ (shift) } : ();
    my $tag = delete $p{Tag} || ++$self->{tag};
    my($dev) = @_;

    $self->command(['STOP_LOCATION_TRACK',$dev],\%p,$tag)
	or return undef;
    $tag;
}

=head3 stop_location_track ( $device_id )

Alias for C.

=cut

sub stop_location_track
{
    my $self = shift;
    $self->request_stop_location_track(@_);
}

=head3 start_area_track ( [ $properties ], $device_id )

Ask the Ekahau engine to start sending area information about
device C<$device_id>.  You can get responses with L.

An optional hash reference can be supplied with a list of properties.
The special property C will be used to set the command tag if
given (otherwise a tag will be generated).  Other properties will be
sent along in the Ekahau request.  This command recognizes all of the parameters used by L, and also these:

=over 4

=item EPE.NUMBER_OF_AREAS

How many areas you'd like returned with each area response.  Each will
come with a probability that the user is in that area.

=back

=cut

sub start_area_track
{
    my $self = shift;
    my %p = ref $_[0] ? %{ (shift) } : ();
    my $dev = shift;
    my $tag = delete $p{Tag} || ++$self->{tag};

    $self->command(['START_AREA_TRACK',$dev], \%p, $tag)
	or return undef;
}

=head3 request_stop_area_track ( $device_id )

Ask the Ekahau engine to stop sending area information about
device C<$device_id>.

=cut

sub request_stop_area_track
{
    my $self = shift;
    my %p = ref $_[0] ? %{ (shift) } : ();
    my $tag = delete $p{Tag} || ++$self->{tag};
    my($dev) = @_;

    $self->command(['STOP_AREA_TRACK',$dev],\%p,$tag)
	or return undef;
    $tag;
}

=head3 stop_area_track ( $device_id )

Alias for C.

=cut

sub stop_area_track
{
    my $self = shift;
    $self->request_stop_area_track(@_);
}


=head3 command ( $cmd, $props, $tag )

This is a fairly low-level routine, and shouldn't be needed in normal
use.  It is the only way to send an arbitrary command to the YAX
engine, however, so it is available and documented.

YAX commands look like this:

  <#$tag command arguments
  property1=value1
  property2=value2
  ...
  >

For clarity, we'll call the string sent at the very beginning of first
line command the I, the next whitespace-seperated word the
I, and the remainder of the first line a space-seperated list
called I.  Additional information on other lines we'll call
I.

C<$cmd> is a list reference containing the command and arguments to
send.  It can also be a string, which is the same as specifying a list
with just that string.

C<$props> is a hash reference containing the properties to be sent
with the command.  If it is empty or C, no properties are sent.

C<$tag> is the command's tag, which allows the response to be picked
out of the data coming back from the server.

Here are some examples:

  $self->command(['GET_DEVICE_PROPERTIES',1], {}, 'A1');
  $self->command('GET_DEVICE_LIST',{'NETWORK.IP-ADDRESS' => '10.1.1.1'}, 'B2');

=cut

sub command
{
    my $self = shift;
    my($cmd,$props,$tag)=@_;
    my $data;

    my @args;

    if ($cmd and ref($cmd) eq 'ARRAY')
    {
	$cmd=join(' ',map { (!defined($_) or $_ eq '') ? '""' : $_ } @$cmd);
    }
    if ($props and ref($props) eq 'HASH')
    {
	$cmd .= "\x0d\x0a";
	while (my($key,$val)=each(%$props))
	{
	    if ($key eq 'data')
	    {
		# Data blob
		$data = $val;
		$cmd .= "size=".length($$data)."\x0d\x0a";
	    }
	    elsif (ref($val) and ref($val) eq 'ARRAY')
	    {
		foreach my $prop2 (@$val)
		{
		    $cmd .= $key ."\x0d\x0a";
		    $cmd .= "$_=$prop2->{$_}\x0d\x0a"
			foreach keys %$prop2;
		}
	    }
	    else
	    {
		$cmd .= "$key=$val\x0d\x0a";
	    }
	}
    }
    if ($data)
    {
	$cmd .= 'data='.$$data."\x0d\x0a";
    }
    $self->_sendcmd($cmd, $tag);
}

sub _sendcmd
{
    my $self = shift;
    my($params,$tag) = @_;

    if (defined($tag))
    {
	$tag = "#$tag ";
    }
    else
    {
	$tag = '';
    }
    my $cmd = "<$tag$params>\x0d\x0a";
    $self->_write($cmd);
}

sub _write
{
    my $self = shift;
    my $sock = $self->{_sock};

    warn "SENT: ",join("",@_),"\n"
	if ($ENV{VERBOSE});
    print $sock @_
	or return $self->reterr("socket write error: $!\n");
}

=head2 lasterr ( )

Returns the last error generated by this object, or when called as a
class method the last constructor error that prevented an object from
being created.  The return value is a string describing the error,
suitable for display to the ser.

=head2 Destructors

=head3 DESTROY ( )

When an C object is destroyed, its connection is closed
using the L method.

=cut

sub DESTROY
{
    my $self = shift;
    $self->close
	if ($self->{_sock});
}

1;

=head2 Error Handling

Constructors and most methods return I on error.  To find out
details about the error, you can call the L method, which
will return a string.  If the error happened in the constructor and so
you don't have an object to call a method on, call it as a class
method:

    my $errstr = Ekahau::Base->lasterr;

=head1 AUTHOR

Scott Gifford [e-mail], [e-mail]

Copyright (C) 2005 The Regents of the University of Michigan.

See the file LICENSE included with the distribution for license
information.


=head1 SEE ALSO

L, I
Engine User Guide>, L, L, L,
L, L, L.

=cut

1;