#!/usr/bin/perl # # One day in mid-March 2008 the three core servers of APRS-IS had # client connections in the way that are defined in this script. # # This is a development tool to simulate "real" client load on # APRS core software. None are sending into the server, but # intention here is to see how much output processing load is # caused by these, and what can be done to that part of the # system to improve things. # # Written by Matti Aarnio, OH2MQK, as a part of APRSC software suite. # $VERSION = 'APRS-IS-CORESIMRX version-1.0'; use strict; use POSIX; use IO::Multiplex; select STDOUT; $| = 1; my $quit = 0; my $APRSIS; my $N = 10; my $fdcount = 0; my @specdata = simspecs(); # printf "specdata: $#specdata\n"; ## Now fork me N ways.. if ($N > 1) { foreach my $n (1..$N) { my $pid = fork(); if ($pid == 0) { # Client work($n % $N,$N); exit 0; } } foreach my $n (1..$N) { wait; } } else { work(0, 1); } exit 0; sub work { my ($n1,$N) = @_; my @APRS = (); my $MUX = new IO::Multiplex; my $u; my $n = 0; $fdcount = 0; foreach my $l (@specdata) { ++$n; next unless ($n1 == ($n % $N)); my @spec = split(" ",$l, 3); my $port = $spec[0]; my $call = $spec[1]; my $filter = $spec[2]; next if ($port eq ''); $port = '10152' if ($port eq '23'); # non-super-user driven test server does not serve on port number below 1024 $port = '10152' if ($port eq '10153'); ## No history feeding $port = '10152' if ($port eq '10151'); ## No history feeding $port = '14580' if ($port eq '10253'); ## No history feeding - filtered port $port = '20152' if ($port eq '20153'); ## No history feeding $filter = undef if ($filter eq ''); # printf "Port='%s' call='%s' filter='%s'\n", $port, $call, $filter; $APRSIS = APRS::IS->new('localhost:'.$port, $call, $filter ); if (!defined($APRSIS)) { printf "aprsazel: Failed to open APRS-IS socket! port=%s\n", $port; exit 4; } $MUX->add( $APRSIS->sock() ); ++$fdcount; $u = $APRSIS->socku(); if (defined($u)) { $MUX->add( $u ); } push @APRS, $APRSIS; } $MUX->set_callback_object(__PACKAGE__); $MUX->loop(); } # #my $now = time; #my $last = $now + 60*60; #local $line; # #while (1) { # $now = time; # foreach my $A (@APRS) { # $line = $A->getline; # } #} exit 0; sub mux_input { my $package = shift; my $mux = shift; my $fh = shift; my $data = shift; $$data = ''; } sub mux_eof { my $package = shift; my $MUX = shift; my $fh = shift; $MUX->close($fh); $MUX->remove($fh); --$fdcount; ## count controls only.. if ($fdcount == 0) { $MUX->endloop(); exit 0; } } # ------------------------------------------------------------------------- package APRS::IS; use 5.006; use strict; use warnings; use IO::Handle '_IOFBF'; use IO::Socket::INET; use IO::Select; sub aprspass { my ($a, $h) = (0, 0); map($h ^= ord(uc) << ($a^=8), pop =~ m/./g); return (($h ^ 29666) & 65535); } sub sock { my $self = shift; return $self->{sock}; } sub socku { my $self = shift; return $self->{socku}; } sub new { my $that = shift; my $class = ref($that) || $that; my $udp = ''; # my %atts = @_; my ($url, $mycall, $target_filter_re) = @_; # Just one arg: APRS-IS URL (host:port) # Register the callers package. my $self = { caller_pkg => (caller)[0] }; bless ($self, $class); # parse attrs if ($url =~ m/(.+?):(\d+?)u/) { my $uurl = $1.":".$2; $self->{sock} = IO::Socket::INET->new($uurl); my $u = undef; my $p = undef; $u = IO::Socket::INET->new( Proto => 'udp', PeerAddr => $uurl, Blocking => 0 ); if (defined($u)) { $self->{socku} = $u; # Open local firewall... $u->send("# pim\r\n"); $u->send("# pim\r\n"); # ..all right.. something was sent, # and thus our udp socket was given # a source address. Find it, and add # on login message. $p = $u->sockport(); $udp = " udp ".$p; } } else { $self->{sock} = IO::Socket::INET->new($url); } if (!defined($self->{sock})) { die(__PACKAGE__.": APRS::IS->new(".$url.") failure: ".$!."\n"); } #$self->{select} = IO::Select->new( $self->{sock} ); $self->{aprsmycall} = $mycall; $mycall =~ s/-.*//; $self->{aprspass} = aprspass( uc($mycall) ); if ($self->{aprsmycall} =~ m/CW\d{4}/o) { $self->{aprspass} = -1; } $self->{filterre} = $target_filter_re; # 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); if (defined($self->{filterre})) { $self->{sock}->printf( "user %s pass %s vers %s filter %s".$udp."\r\n", $self->{aprsmycall}, $self->{aprspass}, # -- but we are read-only ! $main::VERSION, $self->{filterre} ); printf( "user %s pass %s vers %s".$udp." filter %s\n", $self->{aprsmycall}, $self->{aprspass}, # -- but we are read-only ! $main::VERSION, $self->{filterre} ); } else { $self->{sock}->printf( "user %s pass %s vers %s".$udp."\r\n", $self->{aprsmycall}, $self->{aprspass}, # -- but we are read-only ! $main::VERSION ); printf( "user %s pass %s vers %s".$udp."\n", $self->{aprsmycall}, $self->{aprspass}, # -- but we are read-only ! $main::VERSION ); } $self->{sock}->flush; # $self->{rbuf} = ' ' x 16000; ############## grr.. not avaibale # $self->{sock}->setbuf( $self->{rbuf} ); $self->{sock}->blocking(0); # my $discard = $self->getline(); $self; } # ------------------------------------------------------------------------- # Get a line, or wait 1 sec sub getline { my $self = shift; my $l = undef; # my @ready; # if (@ready = $self->{select}->can_read(1)) { # Wait at most 1.0 seconds # We have only one socket... if (defined($self->{socku})) { $self->{socku}->recv($l); return $l if (defined($l)); } return $self->{sock}->getline; } sub sendline { my $self = shift; my $line = shift; my @ready; $self->{sock}->blocking(1); $self->{sock}->printf( "%s\r\n", $line); $self->{sock}->flush; $self->{sock}->blocking(0); undef; } # ------------------------------------------------------------------------- package main; sub simspecs { my $simdata = "10152u jFindU-JS 23 findu 14580 OH2KKU-RO a/72/16/58/34 p/OF/OG/OH/OI/OJ 14580 OH2KKU-RO a/72/16/58/34 p/OF/OG/OH/OI/OJ 14580 VE9SJN 14580 KD8CAO-5 b/kd8cao*/k8yse*/k8ou*/kd8cal* 23 KG6VAD 23 STUKEL 23 NK1B 14580 W2CEA m/125 p/KA1MZY/KE5PLN/ r/29/-98/100 1314 VE7WBI 10156 N9OSQ-7 m/350 10154 K8TQ a/50/-130/20/-65 r/65/-152/900 r/20/-156/900 14580 K8YSE 14580 K0FJ-10 r/39/-101/250 t/n 14580 W4DEX-2 14580 KG2LD r/40/-75/50 t/n 14580 CWOP-3 t/w 14580 K7YE m/500 14580 pa3bwe b/PA3BWE-9 14580 VA7MOS-0 a/50/-126/48/-120 14580 GB7DS-AS 14580 KB0NLY-2 m/200 14580 VE1AIC-JS 23 NG0E-15 14580 KC9XG-2 r/41.61/-88.10/50 p/PCSAT/W3ADO-1/RS0ISS/4XTECH/PACB d/PCSAT*/W3ADO-1/RS0ISS*/4XTECH*/PACB* 10152 T2J-ne 14580 URCALL r/37/-81/1500 14580 VE7VIC-AS 14580 DB0HRF-BS 10152 T2SPAIN 23 ei7wdx-3 14580 KB7IVK m/150 14580 W8KHW-DS 10155 LA9FOA-JS r/69.627/18.954/1800 14580 K2DIG-AS 14580 VA6KRM-JS r/53.49069/-113.44910/200 10152 KH6KI-1 14580 K0MDG-AS 14580 W0OMD-BS 20158 WB5BBW-JS m/1000 -p/CW 14580 VE7SUN m/500 10154 AE6QE M/4067 23 N1UEC-3 14580 OH2KKU-RO a/72/16/58/34 p/OF/OG/OH/OI/OJ 20157 K2GE-14 m/100 -p/CW 23 NS8E 14580 KD5KNR r/32/-97/1000 23 W8FSM-5 23 W9IF-7 10154 okfirst a/38/-104/32/-90 20156 KG4WSV-3 m/350 -p/CW 23 VE6NY 14580 KE5BCC-0 m/600 14580 WM5Z-1 m/300 10153 KB4JHU-15 20157 WB4EPG-3 m/150 -p/CW 10152 T2FUKUOKA 10151 PD0JEW 14580 K4SGT m/100 t/n 14580 VE7BZC a/60/-140/47/-85 a/51/-85/43/-52 b/VE7EIS 10253 KC9DGP-1 m/50 10154 K6IB-1 a/50/-130/20/-65 r/65/-152/900 r/20/-156/900 14580 W6HHD-AS 14580 W5LBB-IG a/34.7473/-103.0428/32.96/-99.9888 14580 IGate-LA 23 N1HQ 23 N8XHZ-1 10152 T2SAITAMA 20156 KD4MOJ-9 m/350 -p/CW 10152 T2TUENL 14580 NS9RC-AS 14580 N8VNR -p/CW m/100 b/WB8ZHU* f/WB8ZHU-7/100 f/WB8ZHU/100 20158 KG4USO m/1000 -p/CW 14580 K7JD -p/CW -p/K7JDS p/K7JD/N7RXY b/ROCKY/KC7NPV-7/N7MXO-7/KB1LQP/AD7KV/NG0X-11/KE7ATD-7/K7RKT-2/N13MY b/WR5J-3/WR5J-7/KE7QXT-7/N30YD b/KI6GII-1/KE7QXT-7 p/KD7YOH 10152 KC5DFC 14580 KI6JUL-AS 23 K6TZ-JS 14580 DB0SDA r/51/6/800 14580 LA6TMA-1 m/700 -b/METAR-2 -p/CW 14580 VE5BJM-JS a/60/-120/48/-93 14580 KC0NWS m/500 10157 PP5FMM-1 m/100 14580 W0NH r/39/-94/150 14580 iJOBURG r/-29/24/4000 14580 DB0WZB-BS 23 KE6AFE-14 14580 DB0XIP m/100 20156 AB9FT-10 m/350 -p/CW 10152 WA4DSY 23 KF4UCI 14580 W4EOC -b/CW* m/150 -q/cx -s/_// 14580 KA5MDY r/34/-105/1000 r/30/-98/1000 10152 T2KOBLENZ 14580 WA6KHG-4 14580 VE1NRB m/300 a/60/-127/48/-113 14580 KE5HYW m/500 14580 VE2FET b/VA*/VE*/VO*/CG*/CF*/VC*/VY*/CI*/CH*/VX*/VG*/VB* 14580 ZS6EY-W1 14580 MB7DS 14580 WD4STR-AS 23 K5LSU-5 23 WT7T-6 14580 W4KCQ-AS 10152 T2BRAZIL 14580 OE6XAD-BS 14580 CS3RMD-1 p/CT/CU/EA 14580 N5PHR-10 m/300 14580 W2SRH-1 m/500 14580 KF6FIR-JS 14580 DO0YA-JS a/55/6/47/15 b/ISS*/RS0ISS*/WD5EGC* s//s p/d/ea8/eb8/ec8 -b/CW* 23 DG3IC 14580 DB0GV-15 s/>