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

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

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

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

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

# Written by Scott Gifford <gifford@umich.edu>
# 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;

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

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

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;
}

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

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;
}

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");
}

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;
    }

}

sub can_read
{
    my $self = shift;

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

sub select_handles
{
    my $self = shift;

    ($self->{_sock});
}

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;
}

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;
}

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;
}

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;
}

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;
}

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;
}

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;
}

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

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;
}

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;
}

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

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");
}

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

1;

1;