From 6e0cf833351816c6f0f58117410a3bd2d3f49080 Mon Sep 17 00:00:00 2001 From: Heikki Hannikainen Date: Sun, 23 Mar 2008 00:11:58 +0000 Subject: [PATCH] Added the Ham::APRS::IS module for testing. It's heavily cleaned up from the tools/* scripts, documented, and reports errors more nicely. Includes a connection retry logic (needed when the software takes some time to start up). Added a login test, too. git-svn-id: http://repo.ham.fi/svn/aprsc/trunk@231 3ce903b1-3385-4e86-93cd-f9a4a239f7ac --- tests/cfg-aprsc/basic | 14 +-- tests/libperl/Ham/APRS/IS.pm | 220 +++++++++++++++++++++++++++++++++++ tests/libperl/runproduct.pm | 2 + tests/t/01login.t | 25 ++++ 4 files changed, 250 insertions(+), 11 deletions(-) create mode 100644 tests/libperl/Ham/APRS/IS.pm create mode 100644 tests/t/01login.t diff --git a/tests/cfg-aprsc/basic b/tests/cfg-aprsc/basic index c14f8c1..e4fcbe1 100644 --- a/tests/cfg-aprsc/basic +++ b/tests/cfg-aprsc/basic @@ -53,17 +53,9 @@ Listen "Full feed with CWOP" fullfeed tcp 0.0.0.0 10152 Listen "User-specified filters" userfilter tcp 0.0.0.0 14580 ### Internals ############ -# The number of worker threads to run - set this to the number of -# CPU cores you have. On a single-processor, single-core system, set this -# to 1. On a server with two processors or a new dual-core single-CPU system, -# set to 2. On a system with two dual-core processors, set to 4. -## -## Or set to about 1 per each 50 client connections, minimum 2.. -## The smaller set there is for poll(2) to transfer data from and -## to the kernel, the less work each system call must do - search -## for your balance, too much threads has its own penalties. -## -WorkerThreads 20 +# Only use 3 threads in these basic tests, to keep startup/shutdown times +# short. +WorkerThreads 3 # When running this server as super-user, the server can (in many systems) # increase several resource limits, and do other things that less privileged diff --git a/tests/libperl/Ham/APRS/IS.pm b/tests/libperl/Ham/APRS/IS.pm new file mode 100644 index 0000000..a074d37 --- /dev/null +++ b/tests/libperl/Ham/APRS/IS.pm @@ -0,0 +1,220 @@ + +package Ham::APRS::IS; + +use 5.006; +use strict; +use warnings; + +use IO::Handle '_IOFBF'; +use IO::Socket::INET; +use IO::Select; + +our $VERSION = '0.01'; + +our $aprs_appid = "IS $VERSION"; + +=head1 new(hostport, mycall, filter) + +Initializes a new Ham::APRS::IS socket. Takes two mandatory arguments, +the host:port pair to connect to and your client's callsign, and one optional +argument, the filter string to be sent with the login command. + + my $is = new Ham::APRS::IS('aprs.server.com:12345', 'N0CALL'); + my $is = new Ham::APRS::IS('aprs.server.com:12345', 'N0CALL', 'f/*'); + +=cut + +sub new($$$;$) +{ + my $that = shift; + my $class = ref($that) || $that; + my $self = { }; + bless ($self, $class); + + my($host_port, $mycall, $filter) = @_; + + $self->{'host_port'} = $host_port; + $self->{'mycall'} = $mycall; + $self->{'filter'} = $filter if defined($filter); + + if ($self->{'mycall'} =~ /^CW\d+/i) { + $self->{'aprspass'} = -1; + } else { + $self->{'aprspass'} = aprspass($self->{'mycall'}); + } + + # warn "aprspass for $self->{mycall} is $self->{aprspass}\n"; + + $self->{'state'} = 'init'; + $self->{'error'} = "No errors yet."; + + return $self; +} + +=head1 disconnect() + +Disconnects from the server. Returns 1 on success, 0 on failure. + + $is->disconnect() || die "Failed to disconnect: $is->{error}"; + +=cut + +sub disconnect($) +{ + my($self) = @_; + + if (defined $self->{'sock'}) { + $self->{'sock'}->close; + undef $self->{'sock'}; + } + + $self->{'state'} = 'disconnected'; + + return 1; +} + +=head1 connect(options) + +Connects to the server. Returns 1 on success, 0 on failure. +Takes an optional options hash as a parameter. Currently knows only one parameter, +retryuntil, which specifies the number of seconds to retry the connection. After +each failed attempt the code sleeps for 0.5 seconds before trying again. Defaults +to 0 (no retries). + + $is->connect('retryuntil' => 10) || die "Failed to connect: $is->{error}"; + +=cut + +sub connect($;%) +{ + my($self) = shift; + + my %options = @_; + + if ($self->{'state'} eq 'connected') { + $self->{'error'} = 'Already connected'; + return 0; + } + + my $retryuntil = defined $options{'retryuntil'} ? $options{'retryuntil'} : 0; + my $starttime = time(); + + while (!defined $self->{'sock'}) { + $self->{'sock'} = IO::Socket::INET->new($self->{'host_port'}); + + if (!defined($self->{'sock'})) { + $self->{'error'} = "Failed to connect to $self->{host_port}: $!"; + + if (time() - $starttime >= $retryuntil) { + return 0; + } + + select(undef, undef, undef, 0.5); + } + } + + $self->{'error'} = 'Connected successfully'; + + # printf ( "APRS::IS->new() mycall='%s' aprspass=%d filterre='%s'\n", + # $self->{aprsmycall}, $self->{aprspass}, $self->{filterre} ); + + ## + ## * Need to send on initial connect the following logon line: + ## user callsign pass passcode vers appname versionnum rest_of_line + ## + ## callsign = login callsign-SSID + ## passcode = login passcode per APRS-IS algorithm, -1 = read-only + ## appname = application name (1 word) + ## versionnum = application version number (no spaces) + ## rest_of_line = server command if connecting to a port that supports commands (see Server Commands) + ## + ## (appname and versionnum should not exceed 15 characters) + ## + ## + ## * Need to recognize both TCPIP and TCPXX as TCP/IP stations + ## * Need to provide a means to perform the user validation. This can either be a user entered password, + ## or a client program can automatically figure out the password given the callsign. + ## If the later is used, it is the client programmer's responsibility to be certain that non-amateurs + ## are not given registrations that can validate themselves in APRS-IS. + ## * Probably a good idea to perform some feedback about the limitations of TCPIP without a registration number. + ## + + $self->{'sock'}->blocking(1); + $self->{'state'} = 'connected'; + + my $s; + if (defined($self->{'filter'})) { + $s = sprintf("user %s pass %s vers %s filter %s\r\n", + $self->{'mycall'}, + $self->{'aprspass'}, # -- but we are read-only ! + $aprs_appid, $self->{'filter'} ); + } else { + $s = sprintf("user %s pass %s vers %s\r\n", + $self->{'mycall'}, + $self->{'aprspass'}, # -- but we are read-only ! + $aprs_appid ); + } + + if (!$self->{'sock'}->print($s)) { + $self->{'error'} = "Failed to write login command to $self->{host_port}: $!"; + return 0; + } + + if (!$self->{'sock'}->flush) { + $self->{'error'} = "Failed to flush login command to $self->{host_port}: $!"; + return 0; + } + + $self->{'sock'}->blocking(0); + + return 1; +} + +# ------------------------------------------------------------------------- +# Get a line (blocking) + +sub getline($) +{ + my $self = shift; + + return undef if ($self->{'state'} ne 'connected'); + return $self->{'sock'}->getline; +} + +sub sendline($$) +{ + my($self, $line) = @_; + + return undef if ($self->{'state'} ne 'connected'); + + $self->{'sock'}->blocking(1); + $self->{'sock'}->printf( "%s\r\n", $line); + $self->{'sock'}->flush; + + $self->{'sock'}->blocking(0); +} + +=head1 aprspass($callsign) + +Calculates the APRS passcode for a given callsign. Ignores SSID +and converts the callsign to uppercase as required. Returns an integer. + + my $passcode = Ham::APRS::IS($callsign); + +=cut + +sub aprspass($) +{ + my($call) = @_; + + $call =~ s/-\d+$//; + $call = uc($call); + + my ($a, $h) = (0, 0); + map($h ^= ord(uc) << ($a^=8), $call =~ m/./g); + return (($h ^ 29666) & 65535); +} + + +1; + diff --git a/tests/libperl/runproduct.pm b/tests/libperl/runproduct.pm index b0c0cc8..c171095 100644 --- a/tests/libperl/runproduct.pm +++ b/tests/libperl/runproduct.pm @@ -58,6 +58,8 @@ sub new($$) $self->{'cmdline'} = $prod->{'binary'} . ' ' . $prod->{'stdargs'} . ' ' . $prod->{'cfgfileargs'} . ' ' . $cfgfile; + $self->{'error'} = 'No errors yet'; + return $self; } diff --git a/tests/t/01login.t b/tests/t/01login.t new file mode 100644 index 0000000..6c08fdd --- /dev/null +++ b/tests/t/01login.t @@ -0,0 +1,25 @@ + +# Simple test to login to the server. + +use Test; +BEGIN { plan tests => 7 }; +use runproduct; +use Ham::APRS::IS; +ok(1); # If we made it this far, we're ok. + +my $p = new runproduct('basic'); + +ok(defined $p, 1, "Failed to initialize product runner"); +ok($p->start(), 1, "Failed to start product"); + +my $is = new Ham::APRS::IS("localhost:10152", "N0CALL"); +ok(defined $is, 1, "Failed to initialize Ham::APRS::IS"); + +my $ret = $is->connect('retryuntil' => 8); +ok($ret, 1, "Failed to connect to the server: " . $is->{'error'}); + +$ret = $is->disconnect(); +ok($ret, 1, "Failed to disconnect from the server: " . $is->{'error'}); + +ok($p->stop(), 1, "Failed to stop product"); +