TNChamgate.pl0100755000000000000000000000022207140522343012064 0ustar rootroot$telnet_2 = "./myTelnet.pl 10152 hamgate.rpi.net.au"; $telnet_1 = "./myTelnet.pl 10152 radio-active.net.au"; #$telnet_1 = "./myServer.pl 45175 "; VK2.conf0100664000000000000000000000240107142233614011027 0ustar rootroot#Config file for aprsFilter #prefix is the beginning prefixes that are allowde through regardless of #their position #@prefix = ("VK2","AX2"); @prefix = (); #grid_OK is the allowable GRID squares that come through. 2, 4 or 6 letters # are OK @grid_OK = ("QF59", "QF69", "QF79", "QF58", "QF68", "QF78", "QF57", "QF67", "QF77", "QF56", "QF66", "QF76", "QF55", "QF65", "QF75", "QF09", "QF19", "QF29", "QF39", "QF49", "QF08", "QF18", "QF28", "QF38", "QF48", "QF07", "QF17", "QF27", "QF37", "QF47", "QF06", "QF16", "QF26", "QF36", "QF46", "QF05", "QF15", "QF25", "QF35", "QF45", "QF14", "QF24", "QF23", "QF34", "QF44", "QF33", "QF43", "QF42", "QF54", "QF53", "QF52", "QF51", "QG51", "QG61", "QG50", "QG20", "QG30", "QG40", "QG41", "QG00", "QG10"); #telnet_1 and 2 are the UPLINK and DOWNLINK hosts respecitevly #If there is more than one host, it will connect to one, and if it cant #it will goe to the next #auth_1 is the UPLINK and DOWNLINK authorisation strings. They must be #correct for things to work. $telnet_1 = "./myTelnet.pl 10152 radio-active.net.au"; $auth_1 = "user VK2TDS pass 21422 VERS $version\n\r\n"; $telnet_2 ="cat > /dev/null"; "echo ./myTelnet.pl 23 aprs.net second.aprs.net"; $auth_2 = "user VK2TDS pass 21422 VERS $version\n\r\n"; VK2.conf~0100664000000000000000000000236307142233472011236 0ustar rootroot#Config file for aprsFilter #prefix is the beginning prefixes that are allowde through regardless of #their position @prefix = ("VK2","AX2"); #grid_OK is the allowable GRID squares that come through. 2, 4 or 6 letters # are OK @grid_OK = ("QF59", "QF69", "QF79", "QF58", "QF68", "QF78", "QF57", "QF67", "QF77", "QF56", "QF66", "QF76", "QF55", "QF65", "QF75", "QF09", "QF19", "QF29", "QF39", "QF49", "QF08", "QF18", "QF28", "QF38", "QF48", "QF07", "QF17", "QF27", "QF37", "QF47", "QF06", "QF16", "QF26", "QF36", "QF46", "QF05", "QF15", "QF25", "QF35", "QF45", "QF14", "QF24", "QF23", "QF34", "QF44", "QF33", "QF43", "QF42", "QF54", "QF53", "QF52", "QF51", "QG51", "QG61", "QG50", "QG20", "QG30", "QG40", "QG41", "QG00", "QG10"); #telnet_1 and 2 are the UPLINK and DOWNLINK hosts respecitevly #If there is more than one host, it will connect to one, and if it cant #it will goe to the next #auth_1 is the UPLINK and DOWNLINK authorisation strings. They must be #correct for things to work. $telnet_1 = "./myTelnet.pl 10152 radio-active.net.au"; $auth_1 = "user VK2TDS pass 21422 VERS $version\n\r\n"; $telnet_2 ="cat > /dev/null"; "echo ./myTelnet.pl 23 aprs.net second.aprs.net"; $auth_2 = "user VK2TDS pass 21422 VERS $version\n\r\n"; VKZL.conf0100664000000000000000000000151707141752636011233 0ustar rootroot#Config file for aprsFilter #prefix is the beginning prefixes that are allowde through regardless of #their position @prefix = ("ZVK","ZZL"); #grid_OK is the allowable GRID squares that come through. 2, 4 or 6 letters # are OK @grid_OK = ("OH","PH","QH","RH","OG","PG","QG","RG","OF", "PF","QF","RF","OE","PE","QE","RE","OD","PD","QD","RD"); #telnet_1 and 2 are the UPLINK and DOWNLINK hosts respecitevly #If there is more than one host, it will connect to one, and if it cant #it will goe to the next #auth_1 is the UPLINK and DOWNLINK authorisation strings. They must be #correct for things to work. $telnet_1 = "./myTelnet.pl 23 aprs.net second.aprs.net"; $auth_1 = "user VK2TDS pass 21422 VERS $version\n\r\n"; $telnet_2 = "./myTelnet.pl 10152 radio-active.net.au"; $auth_2 = "user VK2TDS pass 21422 VERS $version\n\r\n"; VKZL.conf~0100664000000000000000000000151707141003761011415 0ustar rootroot#Config file for aprsFilter #prefix is the beginning prefixes that are allowde through regardless of #their position @prefix = ("VK","ZL"); #grid_OK is the allowable GRID squares that come through. 2, 4 or 6 letters # are OK @grid_OK = ("OH","PH","QH","RH","OG","PG","QG","RG","OF", "PF","QF","RF","OE","PE","QE","RE","OD","PD","QD","RD"); #telnet_1 and 2 are the UPLINK and DOWNLINK hosts respecitevly #If there is more than one host, it will connect to one, and if it cant #it will goe to the next #auth_1 is the UPLINK and DOWNLINK authorisation strings. They must be #correct for things to work. $telnet_1 = "./myTelnet.pl 1314 aprs.net second.aprs.net"; $auth_1 = "user VK2TDS pass 21422 VERS $version\n\r\n"; $telnet_2 = "./myTelnet.pl 10152 radio-active.net.au"; $auth_2 = "user VK2TDS pass 21422 VERS $version\n\r\n"; aprsfilter.pl0100755000000000000000000000500207132023646012270 0ustar rootroot#!/usr/bin/perl -w use strict; use Net::hostent; # for OO version of gethostbyaddr use IO::Socket; my ($host, $port, $kidpid, $handle_out, $line); unless (@ARGV == 2) { die "usage: $0 host port" } ($host_out, $port_out) = @ARGV; # create a tcp connection to the specified host and port $handle_out = IO::Socket::INET->new(Proto => "tcp", PeerAddr => $host_out, PeerPort => $port_out) or die "can't connect to port $port on $host: $!"; $port_in = 9000; # pick something not in use $handle_in = IO::Socket::INET->new( Proto => 'tcp', LocalPort => $port_in, Listen => SOMAXCONN, Reuse => 1); die "can't setup server" unless $handle_in; print "[Server $0 accepting clients]\n"; $handle->autoflush(1); # so output gets there right away print STDERR "[Connected to $host:$port]\n"; # split the program into two processes, identical twins die "can't fork: $!" unless defined($kidpid = fork()); # the if{} block runs only in the parent process if ($kidpid) { # copy the socket to standard output while (defined ($line = <$handle_out>)) { print STDOUT $line; } kill("TERM", $kidpid); # send SIGTERM to child } # the else{} block runs only in the child process else { # copy standard input to the socket while (defined ($line = )) { print $handle_out $line; } } #------------------ while ($client = $server->accept()) { $client->autoflush(1); print $client "Welcome to $0; type help for command list.\n"; $hostinfo = gethostbyaddr($client->peeraddr); printf "[Connect from %s]\n", $hostinfo->name || $client->peerhost; print $client "Command? "; while ( <$client>) { next unless /\S/; # blank line if (/quit|exit/i) { last; } elsif (/date|time/i) { printf $client "%s\n", scalar localtime; } elsif (/who/i ) { print $client ho 2>&1; } elsif (/cookie/i ) { print $client /usr/games/fortune 2>&1; } elsif (/motd/i ) { print $client at /etc/motd 2>&1; } else { print $client "Commands: quit date who cookie motd\n"; } } continue { print $client "Command? "; } close $client; }client.pl0100755000000000000000000001553707136255777011431 0ustar rootroot#!/usr/local/bin/perl ########################################################################## # # Slightly hacked and heavily documented simple Client example from # the book Programming Perl, 1st Edition. I don't use the module support # for sockets much because I want the details to be out in the open # (primarily so people can take their Perl sockets knowledge and move to # other languages easily). # # Some things are done a little differently than in the server examples # to give you a little more experience with Perl constructs. # # This client accepts input from standard input, sends the input to a # server, and sends responses from the server to standard output. # # Hacking and documentation by Prof. Golden G. Richard III, Dept. of # Computer Science, University of New Orleans, April 1996-March 1998. # # Command line arguments expected are: serverIPaddress, port # ########################################################################## # # Perl socket stuff is based on, and very similar to, C socket stuff. # The Unix man pages for the various socket system calls such as # 'listen', 'bind', etc. may be very useful to you. To get # information on a particular call, such as 'accept', use the following # command: # # % man -s3N accept # # The -s3N tells man to look in 3N section of the Unix manual, a section # that's not searched by default. # # Use port addresses in the range 5000-6000 for the assignments. # If you get an "address already in use" error, try a different port. # ########################################################################## # In Perl 5 and above, the Socket module contains Perl definitions for # the stuff in the C include file "/usr/include/sys/socket.h". # Rather than manually poking through that include file to get values # for each architecture, a "use Socket" assures that you'll get the right # values. This replaces the following lines in the example in the book: # # $AF_INET = 2; # $SOCK_STREAM = 1; # # which turn out to be wrong for Solaris, anyway... # ($SOCK_STREAM should be 2) use Socket; # Sucks in the command line arguments (resident in the array variable ARGV) # and assigns them to the variables listed in (). In this case, the first # is the IP address of the machine on which the server is # (hopefully) running. The second is the port on which the server is # listening. ($them,$port) = @ARGV; # This checks to see if 'port' has been assigned a value and if it hasn't, # assigns the default port value 2345. If 'them' (the machine on which # the server is running) hasn't been assigned a value, 'localhost' is # assumed. This means that the server is on the same machine as the # client (us). $port = 2345 unless $port; $them = 'localhost' unless $them; # This sets up a signal handler to kill the child we'll create later # in the event that we die $SIG{'Int'} = 'dokill'; # This is a subprogram that does the killing. The variable $child is # initially undefined, so we won't try to kill a non-existant child. # Later it will be the PID of the child we create. sub dokill { kill 9, $child if $child; } # Strings in back quotes like `ls` run the Unix command inside the quotes # and return the output. The hostname command returns the name of the # machine we're running on. 'chop' removes the newline character in the # output from the hostname command. chop($hostname = `hostname`); # Looks up important information related to the network protocol you wish # to use. 'tcp' is a connection-oriented protocol. Look in # /etc/protocols for examples of others. Do NOT change this unless you # know what you're doing. ($name, $aliases, $proto) = getprotobyname('tcp'); # This is a slightly different way of doing the service lookup that was # done in the Server code. Basically, if the specified port is an integer, # the port number lookup isn't done, otherwise it is. ($name, $aliases, $port) = getservbyname($port,'tcp') unless $port =~ /^\d+$/; # Let the user know what port we're using and where the server # is expected to be, just in case (s)he accidentally typed an # incorrect port or machine name. print "Using port $port to connect to server on host $them...\n"; # This looks up numeric IP address information corresponding to the # hostname for the current machine. ($name,$aliases,$type,$len,$thisaddr) = gethostbyname($hostname); # This looks up numeric IP address information corresponding to the # hostname where the server is expected to be running. ($name, $aliases,$type,$len,$thataddr) = gethostbyname($them); # Create one endpoint of the communication link (our end). See the Server # code for a more complete explanation of what 'socket' does. If we # fail to create a socket, 'die' causes execution to terminate and # display the reason ( stored in $! ) for the failure. # Remember that AF_INET and SOCK_STREAM are symbols provided by the # "use Socket;" line. Don't put $ in front of them!! if (socket(S,AF_INET, SOCK_STREAM, $proto)) { print "Socket creation succeeded.\n"; } else { die $!; } # 'bind' connects our socket (just created) to the specified port. As # in the Server code, the $sockaddr thing is just some magic that allows # the parameters to 'bind' and (later) 'connect' to be smooshed together # in the correct way. For most cases this will be "cut and paste" code. # 'this' gives information about who we are; 'that' refers to the server. $sockaddr = 'S n a4 x8'; $this = pack($sockaddr, AF_INET, 0, $thisaddr); $that = pack($sockaddr, AF_INET, $port, $thataddr); if (bind(S, $this)) { print "Bind succeeded.\n"; } else { die $!; } # This is similar to the 'listen' in the server, except the server is # waiting for a call and we're actively initiating the conversation. # 'connect' connects our socket to the server's socket on the other end. if (connect(S, $that)) { print "Connect succeeded.\n"; } else { die $!; } # Force our socket to flush output immediately after a print select(S); $| = 1; # Make standard output the default again select(STDOUT); # The interaction we want is to type lines of input and have them echoed # back by the server. But how can we both wait for input AND be receptive # to the server's output? Answer: By forking a process to accept input # from standard input (the keyboard) and send it to the server and using # our current process to receive and display input from the server. if ($child = fork) { # We're the parent. Read lines of input from the standard input and # send them to the server until end of file is seen. while () { print S; } # Sleep for 3 seconds then... sleep 3; #...then kill ourselves and the child do dokill(); } else { # We're the child. Read lines of input from the server over the # socket S and output them. Stop if end of file is seen. while () { print "Server: $_"; } } myServer.pl0100755000000000000000000002151607136261045011742 0ustar rootroot#!/usr/bin/perl ########################################################################## # # Slightly hacked and heavily documented Server example from # the book Programming Perl, 1st Edition. I don't use the module support # for sockets much because I want the details to be out in the open # (primarily so people can take their Perl sockets knowledge and move to # other languages easily). # # I've rearranged some of the source to put related things side-by-side, # too (The 'pack' and 'bind', for example). # # Hacking and documentation by Prof. Golden G. Richard III, Dept. of # Computer Science, University of New Orleans, April 1996-March 1998. # # Command line arguments expected are: port # ########################################################################## # # Preliminary notes: # # You see the $! thing all over the place. Perl special variables begin # with $ and there are a LOT of them! $! stands for "the current system # error". So if something goes wrong with a system call, $! provides a # diagnosis. If you've ever used 'errno' or 'perror' in C or C++, this # is similar. # Perl socket stuff is based on, and very similar to, C socket stuff. # The Unix man pages for the various socket system calls such as # 'listen', 'bind', etc. may be very useful to you. To get # information on a particular call, such as 'accept', use the following # command: # # % man -s3N accept # # The -s3N tells man to look in 3N section of the Unix manual, a section # that's not searched by default. # # For the assignments, use port addresses in the range 5000-6000. # If you get an "address already in use" error, try a different port. # ########################################################################## # In Perl 5 and above, the Socket module contains Perl definitions for # the stuff in the C include file "/usr/include/sys/socket.h". # Rather than manually poking through that include file to get values # for each architecture, a "use Socket" assures that you'll get the right # values. This replaces the following lines in the example in the book: # # $AF_INET = 2; # $SOCK_STREAM = 1; # # which turn out to be wrong for Solaris, anyway # ($SOCK_STREAM should be 2) use Socket; # Sucks in the command line arguments (resident in the array variable ARGV) # and assigns them to the variables listed in (). In this case, the first # command line argument is the port [more on this later] and it's # placed into the variable 'port'. ($port) = @ARGV; # This checks to see if 'port' has been assigned a value and if it hasn't, # assigns the default port value 2345 $port = 2345 unless $port; # Looks up important information related to the network protocol you wish # to use. 'tcp' is a connection-oriented protocol. Look in # /etc/protocols for examples of others. Don't change this unless you # know what you're doing. ($name, $aliases, $protocol) = getprotobyname('tcp'); # The following line illustrates both how terse Perl can be AND how cool # Perl can be. $port is the port the user specified either on the # command line or by default. =~ is the Perl regular expression binding # operator and !~ is the negation of =~. Regular expressions are # enclosed between / / characters in Perl. \d matches a single digit, # \d+ matches a string of 1 or more digits, ^ specifies "beginning of # string", and $ specifies "end of string". /^\d+$/ as a regular # expression, therefore, matches integers of arbitrary length. # SO... The following line says: "If the port contains any non-digit # characters, look up the port number associated with the symbolic # name specified by the user. The lookup is done against /etc/services. if ($port !~ /^\d+$/) { ($name, $aliases, $port) = getservbyport($port, 'tcp'); } # Let the user know what port we're listening on, just in case (s)he # accidentally typed an incorrect port. print "Listening on port $port...\n"; # 'socket' creates one endpoint for a communication link (think of it as # creating a telephone. Later, someone else will create another telephone # and wires will be attached between them). The S parameter is the handle # associated with the created communication endpoint. AF_INET specifies # that we're talking using ports. AF_UNIX would specify that we'd be # communicating through special files created in the filesystem. This # is very attractive because then you can do away with the port number # business, but unfortunately AF_UNIX sockets only work on the same # machine. SOCK_STREAM sockets communicate using streams of characters. # Another possibility is unreliable datagram communication using # SOCK_DGRAM. Just stick with the parameters used here unless you # know what you're doing, because there are other implications you need # to understand for datagram communication. # In case you're wondering, the AF_INET and SOCK_STREAM symbols are # provided by the 'use Socket;' statement at the top of the file. # You do NOT want to put $'s in front of these symbols. # The 'die' causes execution to terminate with an error message ( which is # stored in $_) if the 'socket' call fails. socket(S,AF_INET,SOCK_STREAM,$protocol) || die "socket : $!"; # The 'bind' hooks your phone to the port number that was specified. # Think of all the ports as a telephone switchboard. 'bind' requires its # parameters to be in a C structure format. 'pack' smooshes things # together into a form that 'bind' can stomach. The $sockaddr thing below # says "An unsigned short, followed by a short in 'network order', # followed by a null-padded 4 character string, followed by 8 null # bytes." It's magic. Don't worry too much about it. $sockaddr = 'S n a4 x8'; $this = pack($sockaddr, AF_INET, $port, "\0\0\0\0"); bind(S, $this) || die "bind : $!"; # The following arranges to queue up as many as 10 clients until we # have a chance to service them. If more than 10 clients "get in line", # the excess may receive "connection refused" errors. listen(S,10) || die "listen: $!"; # Select S temporarily as the default output channel, turn on # autoflushing, then select standard output again. select(S); $| = 1; select(STDOUT); # Create connections as clients "arrive". $con maintains the connection # number of the last client for ($con = 1; ; $con++) { # Let the user know we're waiting for a connection... printf("Waiting for connection %d....\n", $con); # 'accept' blocks until it notices that a connection has been made # to our socket S. When this occurs, the incoming connection is # actually attached to the socket NS rather than S, thus leaving # S free for other incoming connections. # One more time, said another way: # # When we hear the the telephone S ringing, we quickly transfer # the call to a different phone (NS) to accept the call. # This allows S to stay free for the next call. Make sense? # The value that's returned (in $addr) gives some information about # the address of the caller. ($addr = accept(NS,S)) || die $!; # Temporarily set default output to the handle NS so... select(NS); # ...so we can set autoflushing. Setting $| to a non-zero value causes # output to the currently selected output channel to be immediately # flushed. $| = 1; # Set default output back to the standard output channel select(STDOUT); # The 'fork' creates a child process to handle this client. # Remember that 'fork' returns 0 for the child and a positive number # for the parent. if (($child = fork()) != 0) { # We're the parent... # unpack the information returned by 'accept' to get some # (readable) information about the client we're serving and # print it to standard output ($af,$port, $inetaddr) = unpack($sockaddr, $addr); @inetaddr = unpack('C4', $inetaddr); print "Serving connection $con @ Internet address @inetaddr\n"; # NS is the handle for the socket we're listening to; # it's connected to the current client. # reads and returns the next line of input from the # handle NS. The following while loop form is a special Perl # construct that reads input from the handle NS line by line # until the end of file is reached. Each line is placed into # the special Perl variable $_ (the Perl "default value" # variable). while () { # output stuff from client here and... print $_; # ...and echo it back to the client, too. } # Close the socket connection when the client goes away close(NS); # The forked server dies here kill 9, $child; print "# Client went away. Forked server $con exiting...\n"; } else { while (<>){ print NS $_; } } close(NS); } myTNC.pl0100755000000000000000000001307007136777750011133 0ustar rootroot#!/usr/bin/perl $prefix_1 = "VK"; $prefix_2 = "ZL"; $| = 1; #print $#ARGV."\n"; if ($#ARGV >= 0){ require "$ARGV[0]"; }else{ $prefix_1 = "VK"; $prefix_2 = "ZL"; $telnet_2 = "./myTelnet.pl 10152 hamgate.rpi.net.au"; $telnet_1 = "./myTelnet.pl 10152 radio-active.net.au"; } use Net::Telnet (); use IPC::Open2; use IO::Socket; use FileHandle; use Fcntl; $remote = new FileHandle; $RX_READ = new FileHandle; $RX_WRITE = new FileHandle; $WR_READ = new FileHandle; $WR_WRITE = new FileHandle; fcntl ($RX_READ, 4, 04000); fcntl ($WR_READ, 4, 04000); print "myFilter.pl 0.00\n"; # $RX_READ = IO::Socket::INET->new(PeerAddr => 'first.aprs.net', ## PeerPort => '1314', # Timeout => '10', # Proto => 'tcp'); # $RX_READ->autoflush(1); # $RX_WRITE = $WR_READ; #IPC::Open2::open2($RX_READ, $RX_WRITE, "telnet first.aprs.net 1314"); IPC::Open2::open2($RX_READ, $RX_WRITE, $telnet_1); fcntl ($RX_READ, 4, 04000); sleep (3); # $WR_READ = IO::Socket::INET->new(PeerAddr => 'radio-active.net.au', # PeerPort => '10152', # Timeout => '10', # Proto => 'tcp'); # $WR_READ->autoflush(1); # $WR_WRITE = $WR_READ; #IPC::Open2::open2($WR_READ, $WR_WRITE, "telnet radio-active.net.au 10152"); IPC::Open2::open2($WR_READ, $WR_WRITE, $telnet_2); fcntl ($WR_READ, 4, 04000); sleep (3); print $RX_WRITE "user VK2TDS pass 21422 VERS myFilter.pl 0.01\n\r\n"; print $WR_WRITE "user VK2TDS pass 21422 VERS myFilter.pl 0.01\n\r\n"; # $t = new Net::Telnet (port => 1314, errmode => "return" ); # $t->open("uranium"); # @lines = $t->cmd("/usr/bin/who"); # print @lines; while (1 ==1){ $line = <$RX_READ>; $line =~ s/\n//; $line =~ s/\r//; if (length ( $line) > 0) { CHECK ($line); } $line = <$WR_READ>; $line =~ s/\n//; $line =~ s/\r//; if (length ( $line) > 0) { CHECK_Upload($line); } select(undef, undef, undef, 0.25); } sub CHECK_Upload { local ($line) = shift; if (index ($line, "# aprsd") > -1 ){ print "UPLOAD AUTHENTICATE\n"; print $WR_WRITE "user VK2TDS pass 21422 VERS myFilter.pl 0.01\n\r\n"; } if (index ($line, "::") >= 0) { $call_to = substr ($line, index($line, "::")+2, 9); if (index ($call_to, " ") > 0) { $call_to = substr ($call_to, 0, index($call_to, " ")); } $call_to = substr($call_to,0,9); } else { $call_to = ""; } $call = substr($line,0, index ($line, "\>")); if (index($call, "-") > 0 ) { $call = substr($line,0, index ($line, "-")); } if (substr ($call,0,1) eq "}"){ $call = substr ($call, 1,10); } $call = substr ($call,0,9); # print $call."\n"; $OK = 0; $OK = 1; #open up incoming if the packet comes from that station outgoing #************** TO DO # if (($CallArray{$call} == 1) & (defined ($call_to))){ # if ($CallArray{$call} > 0){ # $CallArray{$call} = time; # $OK = 1; # } # } if (index ($call_to, "USERLIST") == 0 || index ($call_to, "javaMSG") == 0 || index ($call_to, "FBB") == 0 || index ($line, "\>FBB:") >= 0 || # was >FBB ********* index ($call, "\#") == 0){ $OK = 0; } if (index ($line, "\>MAIL:") > 0 ){ $message = substr ($line, index($line,"\>MAIL:")+6,200); # print "MESSAGE $message\n"; if (index ($message, "BBS") == 0 || index ($message,"******") >= 0){ $OK = 0; }; } $path = substr ($line, 0, index ($line,":")); $_ = $path; if (/\*[^\*]+\*/ > 0){ # we have TCPIP*,VK2TDS* which is illegal if( index ($line, ",VK4GO\*:") >= 0){ print "*"; $line =~ s/,VK4GO\*:/:/; $OK = 1; } else { $OK = 0; print "BAD"; } } # # we have TCPIP*,VK2TDS* which is illegal # if( index ($line, "\*:") >= 0){ # $star = 1; # $line =~ s/\*:/:/; # } # Delete comments to do if ($OK == 1){ print $RX_WRITE "$line\n"; print "UPLOAD : $call : $call_to :".substr($line,0,50)."\n"; } else { print "UPKILL : $call : $call_to : ".substr($line,0,50)."\n"; } } #COMES FROM #1, REMOTE sub CHECK { local ($line) = shift; if (index ($line, "# aprsd") > -1 ){ print "DOWNLOAD AUTHENTICATE\n"; print $RX_WRITE "user VK2TDS pass 21422 VERS myFilter.pl 0.01\n\r\n"; } if (index ($line, "::") >= 0) { $call_to = substr ($line, index($line, "::")+2, 9); if (index ($call_to, " ") > 0) { $call_to = substr ($call_to, 0, index($call_to, " ")); } $call_to = substr($call_to,0,9); } else { $call_to = ""; } $call = substr($line,0, index ($line, "\>")); if (index($call, "-") > 0 ) { $call = substr($line,0, index ($line, "-")); } if (substr ($call,0,1) eq "}"){ $call = substr ($call, 1,10); } $call = substr ($call,0,9); $star = 0; $_ = substr ($line, 0, index ($line,":")); if (/\*[^\*]+\*/ > 0){ # we have TCPIP*,VK2TDS* which is illegal if( index ($line, "\*:") >= 0){ $star = 1; $line =~ s/\*:/:/; } } # print $call."\n"; $OK = 1; if (index ($line, "\>MAIL:") > 0 ){ $message = substr ($line, index($line,"\>MAIL:")+6,200); print "MESSAGE $message\n"; if (index ($message, "BBS") == 0){ $OK = 0; }; } if (index ($call_to, "USERLIST") == 0 || index ($call_to, "javaMSG") == 0){ $OK = 0; } if ($OK == 1){ if ($star == 1){ print "*";} print "DOWNLOAD : $call : $call_to : ".substr($line,0,50)."\n"; print $WR_WRITE "$line\n"; } else { if (index ($line, "\#") == 0){ print "DOWNKILL : ".substr($line,0,60)."\n"; } else { print "DOWNKILL : ".substr($line,0,60)."\n"; } } }myTelnet.pl0100755000000000000000000000037007140522262011716 0ustar rootroot#!/usr/bin/perl $number = 0; $| = 1; while (1 ==1 ){ $number = $number +1; if ($number > $#ARGV){ $number = 1; } print "#myTelnet OPEN to $number $ARGV[$number]\n"; system ("telnet $ARGV[$number] $ARGV[0]"); sleep (10); } perlFilter.pl0100755000000000000000000001606707142251646012246 0ustar rootroot#!/usr/bin/perl use Net::Telnet (); use IPC::Open2; use IO::Socket; use FileHandle; use Fcntl; $version = "myFilter.pl 0.03"; $| = 1; require ("perlPOS.pl"); if ($#ARGV >= 0){ require "$ARGV[0]"; }else{ print "Please add the name of the configuration file on the command line\n"; die; } $RX_READ = new FileHandle; $RX_WRITE = new FileHandle; $WR_READ = new FileHandle; $WR_WRITE = new FileHandle; IPC::Open2::open2($RX_READ, $RX_WRITE, $telnet_1); IPC::Open2::open2($WR_READ, $WR_WRITE, $telnet_2); fcntl ($RX_READ, 4, 04000); fcntl ($WR_READ, 4, 04000); initialise (@grid_OK); print "$version\n"; while (1 ==1){ $pause = 1; $line = <$RX_READ>; $line =~ s/\n//; $line =~ s/\r//; if (length ( $line) > 0) { CHECK ($line); $pause = 0; } $line = <$WR_READ>; $line =~ s/\n//; $line =~ s/\r//; if (length ( $line) > 0) { CHECK_Upload($line); $pause = 0; } if ($pause == 1){ select(undef, undef, undef, 0.25); } } sub CHECK_Upload { local ($line) = shift; if (index ($line, "# aprsd") > -1 ){ print "UPLOAD AUTHENTICATE\n"; print $WR_WRITE $auth_2; } #this is the myTelnet lines if ((index ($line, "Trying ") == 0 ) | (index ($line, "Connected") == 0) | (index ($line, "Escape") == 0)){ $line = ""; $OK = 0; } if (index ($line, "::") >= 0) { $call_to = substr ($line, index($line, "::")+2, 9); if (index ($call_to, " ") > 0) { $call_to = substr ($call_to, 0, index($call_to, " ")); } $call_to = substr($call_to,0,9); } else { $call_to = ""; } $call = substr($line,0, index ($line, "\>")); if (index($call, "-") > 0 ) { $call = substr($line,0, index ($line, "-")); } if (substr ($call,0,1) eq "}"){ $call = substr ($call, 1,10); } $call = substr ($call,0,9); $OK = 0; $OK = 1; #open up incoming if the packet comes from that station outgoing #************** TO DO # if (($CallArray{$call} == 1) & (defined ($call_to))){ # if ($CallArray{$call} > 0){ # $CallArray{$call} = time; # $OK = 1; # } # } #Junk packets... No use to anyone. if (index ($call_to, "USERLIST") == 0 || index ($call_to, "javaMSG") == 0 || index ($call_to, "FBB") == 0 || index ($line, "\>FBB:") >= 0 || # was >FBB ********* index ($call, "\#") == 0){ $OK = 0; } if (index ($line, "\>MAIL:") > 0 ){ $message = substr ($line, index($line,"\>MAIL:")+6,200); if (index ($message, "BBS") == 0 || index ($message,"******") >= 0){ $OK = 0; }; } $path = substr ($line, 0, index ($line,":")); $_ = $path; if (/\*[^\*]+\*/ > 0){ # we have TCPIP*,VK2TDS* which is illegal if( index ($line, ",VK4GO\*:") >= 0){ print "*"; $line =~ s/,VK4GO\*:/:/; $OK = 1; } else { $OK = 0; print "BAD"; } } #Packet is too short if (length($line) < 10){ $OK = 0; } # # we have TCPIP*,VK2TDS* which is illegal # if( index ($line, "\*:") >= 0){ # $star = 1; # $line =~ s/\*:/:/; # } # Delete comments to do if ($OK == 1){ print $RX_WRITE "$line\n"; print "UPLOAD : $call : $call_to :".substr($line,0,50)."\n"; } else { print "UPKILL : $call : $call_to : ".substr($line,0,50)."\n"; } } sub CHECK { local ($line) = shift; $debug = ""; # If we receive the signon message, then we have a new connection. Then # we need to send the AUTHENTIFICATION message if (index ($line, "# aprsd") > -1 ){ print "DOWNLOAD AUTHENTICATE\n"; print $WR_WRITE $auth_1; } # There are several messages from myTelnet.pl that should be deleted. # so we delete them :-) if ((index ($line, "Trying ") == 0 ) | (index ($line, "Connected") == 0) | (index ($line, "telnet") == 0) | (index ($line, "Escape") == 0)){ $line = ""; $OK = 0; } # If there is a TO call in the message, extract this. Else blank. Remove # any spaces from the callsign. if (index ($line, "::") >= 0) { $call_to = substr ($line, index($line, "::")+2, 9); if (index ($call_to, " ") > 0) { $call_to = substr ($call_to, 0, index($call_to, " ")); } $call_to = substr($call_to,0,9); if (index($call_to, "-") >0){ $call_to = substr($call_to,0, index ($call_to, "-")); } # print "call$call_to\n"; } else { $call_to = ""; } # Work out the FROM callsign, removing the SSID # if the first charcter is a { remove it... $call = substr($line,0, index ($line, "\>")); if (index($call, "-") > 0 ) { $call = substr($line,0, index ($line, "-")); } if (substr ($call,0,1) eq "}"){ $call = substr ($call, 1,10); } $call = substr ($call,0,9); # Sometimes wer get TCPIP*,VK2TDS* which is illegal $star = 0; $_ = substr ($line, 0, index ($line,":")); if (/\*[^\*]+\*/ > 0){ # we have TCPIP*,VK2TDS* which is illegal if( index ($line, "\*:") >= 0){ $star = 1; $line =~ s/\*:/:/; } } $OK = 0; # print $CallArray{$call}; # Have we previously been defined as a LOCAL by CALLSIGN? The Callsign # array is then set to = 1 if ($CallArray{$call} == 1) { $OK = 1; $debug = $debug . " [ PREVIOUSLY VERIFIED ]"; } else { # Search for the callsign prefix. If we find it, Define it as being # local foreach $prefix (@prefix){ if ( index ($call, $prefix) == 0){ $CallArray{$call} = 1; $OK = 1; $debug = $debug . " [ CALLSIGN VERIFIED ]"; } } } #?????? #OK if the too call has been validated by position # NOTE: If we use >1 for CallArray(Call_To) we will get a cascade of # opening up. Station A opens B opens C if (defined ($call_to) & ($CallArray{$call_to} == 1)){ if ((! defined ($CallArray{$call})) | ($CallArray{$call} > 1 )){ $CallArray{$call} = time; } $OK = 1; $debug = $debug . " [ TO CALLSIGN ALREADY VERIFIED ]"; } # If the TO callsign is within the range let it through. foreach $prefix (@prefix){ if ( index ($call, $prefix) == 0){ if ((! defined ($CallArray{$call})) | ($CallArray{$call} > 1 )){ $CallArray{$call} = time; } $OK = 1; $debug = $debug . " [ TO CALLSIGN VERIFIED ]"; } } # If we are not letting the packet through by callsign, then see if we # should let it through by POSITION if ($OK == 0){ # $show = 1; $mygrid = validate_line ($line); if (length($mygrid) > 1){ $CallArray{$call} = 1; $OK = 1; $debug = $debug . " [ POSITION OK ]"; } } #why? #reset the timer. if ((defined ($call_to))){ if (($CallArray{$call} > 1)){ $CallArray{$call} = time; $OK = 1; } } #BUG**** TIMEOUT if (defined ($CallArray{$call})){ $diff = time - $CallArray{$call}; if (($OK == 0) & ($diff < 3200)){ $OK = 1; $debug = $debug . " [ TIMEOUT BUG ]"; } } if (index ($line, "\>MAIL:") > 0 ){ $message = substr ($line, index($line,"\>MAIL:")+6,200); print "MESSAGE KILLED $message\n"; # if (index ($message, "BBS") == 0){ $OK = 0; # }; } if (index ($call_to, "USERLIST") == 0 || index ($call_to, "javaMSG") == 0){ $OK = 0; } if ($OK == 1){ print $debug."\n"; if ($star == 1){ print "*";} print "DOWNLOAD : $call : $call_to : ".substr($line,0,50)."\n"; print $WR_WRITE "$line\n"; } else { if (index ($line, "\#") == 0){ print "DOWNKILL : ".substr($line,0,60)."\n"; } else { # print "DOWNKILL : ".substr($line,0,60)."\n"; } } }perlFilter.pl~0100755000000000000000000001613107142250707012431 0ustar rootroot#!/usr/bin/perl use Net::Telnet (); use IPC::Open2; use IO::Socket; use FileHandle; use Fcntl; $version = "myFilter.pl 0.03"; $| = 1; require ("perlPOS.pl"); if ($#ARGV >= 0){ require "$ARGV[0]"; }else{ print "Please add the name of the configuration file on the command line\n"; die; } $RX_READ = new FileHandle; $RX_WRITE = new FileHandle; $WR_READ = new FileHandle; $WR_WRITE = new FileHandle; IPC::Open2::open2($RX_READ, $RX_WRITE, $telnet_1); IPC::Open2::open2($WR_READ, $WR_WRITE, $telnet_2); fcntl ($RX_READ, 4, 04000); fcntl ($WR_READ, 4, 04000); initialise (@grid_OK); print "$version\n"; while (1 ==1){ $pause = 1; $line = <$RX_READ>; $line =~ s/\n//; $line =~ s/\r//; if (length ( $line) > 0) { CHECK ($line); $pause = 0; } $line = <$WR_READ>; $line =~ s/\n//; $line =~ s/\r//; if (length ( $line) > 0) { CHECK_Upload($line); $pause = 0; } if ($pause == 1){ select(undef, undef, undef, 0.25); } } sub CHECK_Upload { local ($line) = shift; if (index ($line, "# aprsd") > -1 ){ print "UPLOAD AUTHENTICATE\n"; print $WR_WRITE $auth_2; } #this is the myTelnet lines if ((index ($line, "Trying ") == 0 ) | (index ($line, "Connected") == 0) | (index ($line, "Escape") == 0)){ $line = ""; $OK = 0; } if (index ($line, "::") >= 0) { $call_to = substr ($line, index($line, "::")+2, 9); if (index ($call_to, " ") > 0) { $call_to = substr ($call_to, 0, index($call_to, " ")); } $call_to = substr($call_to,0,9); } else { $call_to = ""; } $call = substr($line,0, index ($line, "\>")); if (index($call, "-") > 0 ) { $call = substr($line,0, index ($line, "-")); } if (substr ($call,0,1) eq "}"){ $call = substr ($call, 1,10); } $call = substr ($call,0,9); $OK = 0; $OK = 1; #open up incoming if the packet comes from that station outgoing #************** TO DO # if (($CallArray{$call} == 1) & (defined ($call_to))){ # if ($CallArray{$call} > 0){ # $CallArray{$call} = time; # $OK = 1; # } # } #Junk packets... No use to anyone. if (index ($call_to, "USERLIST") == 0 || index ($call_to, "javaMSG") == 0 || index ($call_to, "FBB") == 0 || index ($line, "\>FBB:") >= 0 || # was >FBB ********* index ($call, "\#") == 0){ $OK = 0; } if (index ($line, "\>MAIL:") > 0 ){ $message = substr ($line, index($line,"\>MAIL:")+6,200); if (index ($message, "BBS") == 0 || index ($message,"******") >= 0){ $OK = 0; }; } $path = substr ($line, 0, index ($line,":")); $_ = $path; if (/\*[^\*]+\*/ > 0){ # we have TCPIP*,VK2TDS* which is illegal if( index ($line, ",VK4GO\*:") >= 0){ print "*"; $line =~ s/,VK4GO\*:/:/; $OK = 1; } else { $OK = 0; print "BAD"; } } #Packet is too short if (length($line) < 10){ $OK = 0; } # # we have TCPIP*,VK2TDS* which is illegal # if( index ($line, "\*:") >= 0){ # $star = 1; # $line =~ s/\*:/:/; # } # Delete comments to do if ($OK == 1){ print $RX_WRITE "$line\n"; print "UPLOAD : $call : $call_to :".substr($line,0,50)."\n"; } else { print "UPKILL : $call : $call_to : ".substr($line,0,50)."\n"; } } sub CHECK { local ($line) = shift; $debug = ""; # If we receive the signon message, then we have a new connection. Then # we need to send the AUTHENTIFICATION message if (index ($line, "# aprsd") > -1 ){ print "DOWNLOAD AUTHENTICATE\n"; print $WR_WRITE $auth_1; } # There are several messages from myTelnet.pl that should be deleted. # so we delete them :-) if ((index ($line, "Trying ") == 0 ) | (index ($line, "Connected") == 0) | (index ($line, "telnet") == 0) | (index ($line, "Escape") == 0)){ $line = ""; $OK = 0; } # If there is a TO call in the message, extract this. Else blank. Remove # any spaces from the callsign. if (index ($line, "::") >= 0) { $call_to = substr ($line, index($line, "::")+2, 9); if (index ($call_to, " ") > 0) { $call_to = substr ($call_to, 0, index($call_to, " ")); } $call_to = substr($call_to,0,9); if (index($call_to, "-") >0){ $call_to = substr($call_to,0, index ($call_to, "-")); } # print "call$call_to\n"; } else { $call_to = ""; } # Work out the FROM callsign, removing the SSID # if the first charcter is a { remove it... $call = substr($line,0, index ($line, "\>")); if (index($call, "-") > 0 ) { $call = substr($line,0, index ($line, "-")); } if (substr ($call,0,1) eq "}"){ $call = substr ($call, 1,10); } $call = substr ($call,0,9); # Sometimes wer get TCPIP*,VK2TDS* which is illegal $star = 0; $_ = substr ($line, 0, index ($line,":")); if (/\*[^\*]+\*/ > 0){ # we have TCPIP*,VK2TDS* which is illegal if( index ($line, "\*:") >= 0){ $star = 1; $line =~ s/\*:/:/; } } $OK = 0; # print $CallArray{$call}; # Have we previously been defined as a LOCAL by CALLSIGN? The Callsign # array is then set to = 1 if ($CallArray{$call} == 1) { $OK = 1; $debug = $debug . " [ PREVIOUSLY VERIFIED ]"; } else { # Search for the callsign prefix. If we find it, Define it as being # local foreach $prefix (@prefix){ if ( index ($call, $prefix) == 0){ $CallArray{$call} = 1; $OK = 1; $debug = $debug . " [ CALLSIGN VERIFIED ]"; } } } #?????? #OK if the too call has been validated by position # NOTE: If we use >1 for CallArray(Call_To) we will get a cascade of # opening up. Station A opens B opens C if (defined ($call_to) & ($CallArray{$call_to} == 1)){ if ((! defined ($CallArray{$call})) | ($CallArray{$call} > 1 )){ $CallArray{$call} = time; } $OK = 1; $debug = $debug . " [ TO CALLSIGN ALREADY VERIFIED ]"; } # If the TO callsign is within the range let it through. foreach $prefix (@prefix){ if ( index ($call, $prefix) == 0){ if ((! defined ($CallArray{$call})) | ($CallArray{$call} > 1 )){ $CallArray{$call} = time; } $OK = 1; $debug = $debug . " [ TO CALLSIGN VERIFIED ]"; } } # If we are not letting the packet through by callsign, then see if we # should let it through by POSITION if ($OK == 0){ # $show = 1; $mygrid = validate_line ($line); if (length($mygrid) > 1){ $CallArray{$call} = 1; $OK = 1; $debug = $debug . " [ POSITION OK ]"; } } #why? #reset the timer. if ((defined ($call_to))){ if ((! defined ($CallArray{$call})) | ($CallArray{$call} > 1)){ $CallArray{$call} = time; $OK = 1; } } #BUG**** TIMEOUT if (defined ($CallArray{$call})){ $diff = time - $CallArray{$call}; if (($OK == 0) & ($diff < 3200)){ $OK = 1; $debug = $debug . " [ TIMEOUT BUG ]"; } } if (index ($line, "\>MAIL:") > 0 ){ $message = substr ($line, index($line,"\>MAIL:")+6,200); print "MESSAGE KILLED $message\n"; # if (index ($message, "BBS") == 0){ $OK = 0; # }; } if (index ($call_to, "USERLIST") == 0 || index ($call_to, "javaMSG") == 0){ $OK = 0; } if ($OK == 1){ print $debug."\n"; if ($star == 1){ print "*";} print "DOWNLOAD : $call : $call_to : ".substr($line,0,50)."\n"; print $WR_WRITE "$line\n"; } else { if (index ($line, "\#") == 0){ print "DOWNKILL : ".substr($line,0,60)."\n"; } else { # print "DOWNKILL : ".substr($line,0,60)."\n"; } } }perlPOS.pl0100755000000000000000000003133407140272574011455 0ustar rootroot#!/usr/bin/perl -w # ============================================================================= # FILE: perlAPRS # # VERSION: 1.0.3 # # AUTHOR: Richard Parry, W9IF # # DESCRIPTION: This perl program will read a command file that # provides a callsign, command, grid sqaure, and command count. # The program will then listen to an APRS port and execute the command # script if that station is heard in the grid square specified. # # SOURCE: See perlAPRS web page for latest version and further # details of how to use perlAPRS # # http://people.qualcomm.com/rparry # # Type the following command to get short help menu: # # perlAPRS -h # # ============================================================================= require 5.002; @APRSsigns = ("AIR", "ALL", "AP", "ID", "CQ", "QST", "BEACON", "MAIL", "SKY", "GPS", "DFNET", "SPCL", "TEST", "DRILL", "AIR", "DF", "DGPS", "DRILL", "DX", "JAVA", "MICE", "QTH", "RTCM", "SPC", "SYM", "TEL", "TEST", "TLM", "WX", "ZIP" ); # These arrays of hashes (associative array) are used to ease the computation # of the grid squares. Since lat and lon are in mixed format containing # Degrees, Minutes, and Decimal Minutes, the computation is not # straight forward. %gridchar4 = ( A => {deg => '0', min => '00',}, B => {deg => '1', min => '55',}, C => {deg => '1', min => '50',}, D => {deg => '1', min => '45',}, E => {deg => '1', min => '40',}, F => {deg => '1', min => '35',}, G => {deg => '1', min => '30',}, H => {deg => '1', min => '25',}, I => {deg => '1', min => '20',}, J => {deg => '1', min => '15',}, K => {deg => '1', min => '10',}, L => {deg => '1', min => '05',}, M => {deg => '1', min => '00',}, N => {deg => '2', min => '55',}, O => {deg => '2', min => '50',}, P => {deg => '2', min => '45',}, Q => {deg => '2', min => '40',}, R => {deg => '2', min => '35',}, S => {deg => '2', min => '30',}, T => {deg => '2', min => '25',}, U => {deg => '2', min => '20',}, V => {deg => '2', min => '15',}, W => {deg => '2', min => '10',}, X => {deg => '2', min => '05',}, Y => {deg => '2', min => '00',}, ); %gridchar5 = ( A => {deg => '0', min => '00', decmin => '.0'}, B => {deg => '0', min => '02', decmin => '.5'}, C => {deg => '0', min => '05', decmin => '.0'}, D => {deg => '0', min => '07', decmin => '.5'}, E => {deg => '0', min => '10', decmin => '.0'}, F => {deg => '0', min => '12', decmin => '.5'}, G => {deg => '0', min => '15', decmin => '.0'}, H => {deg => '0', min => '17', decmin => '.5'}, I => {deg => '0', min => '20', decmin => '.0'}, J => {deg => '0', min => '22', decmin => '.5'}, K => {deg => '0', min => '25', decmin => '.0'}, L => {deg => '0', min => '27', decmin => '.5'}, M => {deg => '0', min => '30', decmin => '.0'}, N => {deg => '0', min => '32', decmin => '.5'}, O => {deg => '0', min => '35', decmin => '.0'}, P => {deg => '0', min => '37', decmin => '.5'}, Q => {deg => '0', min => '40', decmin => '.0'}, R => {deg => '0', min => '42', decmin => '.5'}, S => {deg => '0', min => '45', decmin => '.0'}, T => {deg => '0', min => '47', decmin => '.5'}, U => {deg => '0', min => '50', decmin => '.0'}, V => {deg => '0', min => '52', decmin => '.5'}, W => {deg => '0', min => '55', decmin => '.0'}, X => {deg => '0', min => '57', decmin => '.5'}, Y => {deg => '0', min => '60', decmin => '.0'}, ); # Fixed subscripts into the database array "cinput" # The first 4 values are read in from the user's command file. $ptrgridsquare = 1; $ptrlatlow = 2; $ptrlonlow = 3; $ptrlatupr = 4; $ptrlonupr = 5; # ----------------------------------------------------------------------------- # Global Variable Declarations and Initialization # ----------------------------------------------------------------------------- # ============================================================================= # MAIN PROGRAM # ============================================================================= sub initialise { @command = @_; $cmdcount = 0; foreach $com (@command){ $com =~ s/\W//; $cinput[$cmdcount][$ptrgridsquare]= $com; $cmdcount++; } if ($show) { print "\n\t\t\t*** ACCEPT ***\n"; print " Grid LwrLat LwrLon UprLat UprLon\n"; } for ($i = 0; $i < $cmdcount; $i++) { @grid = unpack "cccccc", $cinput[$i][$ptrgridsquare]; # For 2 Letter Grid Square if (scalar @grid == 2) { $latlow = (($grid[1] - 65) * 10 - 90) * 100; $lonlow = (($grid[0] - 65) * 20 - 180) * 100; $latupr = $latlow + 1000; $lonupr = $lonlow + 2000; } # For 4 Letter Grid Square if (scalar @grid == 4) { $latlow = (($grid[1] - 65) * 10 + ($grid[3] - 48) * 1 - 90) * 100; $lonlow = (($grid[0] - 65) * 20 + ($grid[2] - 48) * 2 - 180) * 100; $latupr = $latlow + 100; $lonupr = $lonlow + 200; } # For 6 Letter Grid Square format "DegreesMinutes.DecimalMinutes" if (scalar @grid == 6) { # compute latitude of lower corner $latdegrees = ($grid[1] - 65) * 10 + ($grid[3] - 48) - 90 + $gridchar5{chr($grid[5])}{deg}; $latlow = pack "a*a*a*", $latdegrees, $gridchar5{chr($grid[5])}{min}, $gridchar5{chr($grid[5])}{decmin}; # compute longitude of lower corner $londegrees = ($grid[0] - 65) * 20 + ($grid[2] - 48) * 2 - 180 + $gridchar4{chr($grid[4])}{deg}; $lonlow = pack "a*a*", $londegrees, $gridchar4{chr($grid[4])}{min}; # compute latitude of upper corner $char5 = chr($grid[5] + 1); # increment character $latdegrees = ($grid[1] - 65) * 10 + ($grid[3] - 48) - 90 + $gridchar5{$char5}{deg}; $latupr = pack "a*a*a*", $latdegrees, $gridchar5{$char5}{min}, $gridchar5{$char5}{decmin}; # compute longitude of upper corner $char4 = chr($grid[4] + 1); # increment character $londegrees = ($grid[0] - 65) * 20 + ($grid[2] - 48) * 2 - 180 + $gridchar4{$char4}{deg}; $lonupr = pack "a*a*", $londegrees, $gridchar4{$char4}{min}; } $cinput[$i][$ptrlatlow] = $latlow; $cinput[$i][$ptrlonlow] = $lonlow; $cinput[$i][$ptrlatupr] = $latupr; $cinput[$i][$ptrlonupr] = $lonupr; # Print comparison array which contains all data for each callsign if ($show) { printf "%02d %6s %8.1f %8.1f %8.1f %8.1f\n", $i + 1, $cinput[$i][$ptrgridsquare], $cinput[$i][$ptrlatlow], $cinput[$i][$ptrlonlow], $cinput[$i][$ptrlatupr], $cinput[$i][$ptrlonupr]; } } } sub validate_line { local ($_) = shift; chomp; # remove newline char my $packet = $_; # save the packet if (length $packet eq 0) { return (""); }; # skip all if a null packet if ($show) { print "Packet= $packet\n"; # print input line } # # Split up the packet and store elements into array # ($fromcallsign) = split(/>/, $packet, 0); # split packet by ">" delimiter $fromcallsign =~ s/\*//; # remove any trailing * char $fromcallsign =~ s/^[^A-Z]//; # remove leading non-alpha chars # # In this block, search for a valid "TO" address. If none found set flag # and exit block. If found, set flag for valid APRS packet. However, # additional testing will be done later to confirm packet contains valid # latitude and longitude values. # If the portion of the packet that we now have begins with a legitimate # "TO ADDRESS", then accept this packet and proceed, but remove the # TO ADDRESS, it is no longer needed. # APRSBLOCK: { $validaprs = 1; # assume legitimate APRS packet foreach $testcall (@APRSsigns) { if ($packet =~ m/\>$testcall/) { # search for leading ">" + sign last APRSBLOCK; } } $validaprs = 0; # set flag, not APRS packet } # END APRSBLOCK # # Extract Lat and Long if in form 99.99?N/99999.99?W # or 99.99?N\99999.99?W # or 99.99?N[A-Z]99999.99?W # TNCBLOCK: { if($validaprs) { $validtnc = 1; # assume valid latitude or longitude # if ($packet =~ m/([0-9][0-9][0-9][0-9]\.[0-9][0-9][0-9]?[N|n][A-Z|\/][0-9][0-9][0-9][0-9][0-9]\.[0-9][0-9][0-9]?[W|w])/) if ($packet =~ m/([0-9][0-9][0-9][0-9]\.[0-9][0-9][0-9]?[S|s|N|n].[0-9][0-9][0-9][0-9][0-9]\.[0-9][0-9][0-9]?[W|w|E|e])/) { $latlong = $1; # save latitude and longitude $latlong =~ m/([0-9][0-9][0-9][0-9]\.[0-9][0-9][0-9]?)/; $lat = $1; if ($latlong =~ m/([0-9][0-9][0-9][0-9]\.[0-9][0-9][0-9]?[S|s])/){ $lat = -$lat; } $latlong =~ m/([0-9][0-9][0-9][0-9][0-9]\.[0-9][0-9][0-9]?)/; $long = $1; if ($latlong =~ m/([0-9][0-9][0-9][0-9][0-9]\.[0-9][0-9][0-9]?[W|w])/){ $long = -$long; } last TNCBLOCK; } $validtnc = 0; # not valid latitude or longitude } } # END TNCBLOCK # # Now find out if it is a NMEA standard string # Strings supported are: # $GPGGA Global Positioning System Fix Data # $GPGLL Geographic position, latitude and longitude # $GPRMC Recommended minimum specific GPS/Transit data # NMEASWITCH: { if($validaprs && !$validtnc) { $validnmea = 1; # assume valid NMEA packet if ($packet =~ m/\$GPGGA/) { # separate header and payload, we need only the payload) ($header, $payload) = split(/\$GPGGA/, $packet); # $payload =~ s/[A-Z]//g; # remove chars in bad NMEAs @posit = split(/,/, $payload); # disect $GP sentence into fields if (index ($posit[2], "N") >= 0){ $lat = $posit[2]; # extract latitude } else { $lat = -$posit[2]; # extract latitude } if (index ($posit[4], "E") >= 0){ $long = $posit[4]; # extract longitude } else { $long = -$posit[4]; # extract longitude } $lat =~ s/[A-Z]//g; $long =~ s/[A-Z]//g; if ($lat eq "" or $long eq "") { $validnmea = 0} # invalid NMEA last NMEASWITCH; } if ($packet =~ m/\$GPGLL/) { # separate header and payload, we need only the payload) ($header, $payload) = split(/\$GPGLL/, $packet); # $payload =~ s/[A-Z]//g; # remove chars in bad NMEAs @posit = split(/,/, $payload); # disect $GP sentence into fields if (index ($posit[1], "N") >= 0){ $lat = $posit[1]; # extract latitude } else { $lat = -$posit[1]; # extract latitude } if (index ($posit[3], "E") >= 0){ $long = $posit[3]; # extract longitude } else { $long = -$posit[3]; # extract longitude } $lat =~ s/[A-Z]//g; $long =~ s/[A-Z]//g; if ($lat eq "" or $long eq "") { $validnmea = 0} # invalid NMEA last NMEASWITCH; } if ($packet =~ m/\$GPRMC/) { # separate header and payload, we need only the payload) ($header, $payload) = split(/\$GPRMC/, $packet); # $payload =~ s/[A-Z]//g; # remove chars in bad NMEAs @posit = split(/,/, $payload); # disect $GP sentence into fields if (index ($posit[3], "N") >= 0){ $lat = $posit[3]; # extract latitude } else { $lat = -$posit[4]; # extract latitude } if (index ($posit[5], "E") >= 0){ $long = $posit[5]; # extract longitude } else { $long = -$posit[5]; # extract longitude } $lat =~ s/[A-Z]//g; $long =~ s/[A-Z]//g; if ($lat eq "" or $long eq "") { $validnmea = 0} # invalid NMEA last NMEASWITCH; } $validnmea = 0; # Invalid NMEA packet } } # END NMEA BLOCK # # We have valid APRS packet, check for match in command database, if so execute # if ($validaprs && ($validtnc or $validnmea)) { if ($show) { printf "\t%11s %4.3f %5.3f\n", $fromcallsign, $lat, $long; } # Current version assumes station is in North American, # N,S,E,W parameters ignored, therefore force to negative longitude # $long = -$long; # Is packet from within the gridsquare of any callsign in the database for ($i = 0; $i < $cmdcount; $i++) { if(($lat > $cinput[$i][$ptrlatlow]) && ($lat < $cinput[$i][$ptrlatupr]) && ($long > $cinput[$i][$ptrlonlow]) && ($long < $cinput[$i][$ptrlonupr])) { # get current time to time stamp this packet if ($show) { $cinput[$i][$ptrgridsquare]; } return ($cinput[$i][$ptrgridsquare]); } } } else { if ($debug) { print "*No Posit= $packet\n"; } # next; } #sleep 1; # For testing only } 1;server.pl0100755000000000000000000002204607136255747011447 0ustar rootroot#!/usr/local/bin/perl ########################################################################## # # Slightly hacked and heavily documented Server example from # the book Programming Perl, 1st Edition. I don't use the module support # for sockets much because I want the details to be out in the open # (primarily so people can take their Perl sockets knowledge and move to # other languages easily). # # I've rearranged some of the source to put related things side-by-side, # too (The 'pack' and 'bind', for example). # # Hacking and documentation by Prof. Golden G. Richard III, Dept. of # Computer Science, University of New Orleans, April 1996-March 1998. # # Command line arguments expected are: port # ########################################################################## # # Preliminary notes: # # You see the $! thing all over the place. Perl special variables begin # with $ and there are a LOT of them! $! stands for "the current system # error". So if something goes wrong with a system call, $! provides a # diagnosis. If you've ever used 'errno' or 'perror' in C or C++, this # is similar. # Perl socket stuff is based on, and very similar to, C socket stuff. # The Unix man pages for the various socket system calls such as # 'listen', 'bind', etc. may be very useful to you. To get # information on a particular call, such as 'accept', use the following # command: # # % man -s3N accept # # The -s3N tells man to look in 3N section of the Unix manual, a section # that's not searched by default. # # For the assignments, use port addresses in the range 5000-6000. # If you get an "address already in use" error, try a different port. # ########################################################################## # In Perl 5 and above, the Socket module contains Perl definitions for # the stuff in the C include file "/usr/include/sys/socket.h". # Rather than manually poking through that include file to get values # for each architecture, a "use Socket" assures that you'll get the right # values. This replaces the following lines in the example in the book: # # $AF_INET = 2; # $SOCK_STREAM = 1; # # which turn out to be wrong for Solaris, anyway # ($SOCK_STREAM should be 2) use Socket; # Sucks in the command line arguments (resident in the array variable ARGV) # and assigns them to the variables listed in (). In this case, the first # command line argument is the port [more on this later] and it's # placed into the variable 'port'. ($port) = @ARGV; # This checks to see if 'port' has been assigned a value and if it hasn't, # assigns the default port value 2345 $port = 2345 unless $port; # Looks up important information related to the network protocol you wish # to use. 'tcp' is a connection-oriented protocol. Look in # /etc/protocols for examples of others. Don't change this unless you # know what you're doing. ($name, $aliases, $protocol) = getprotobyname('tcp'); # The following line illustrates both how terse Perl can be AND how cool # Perl can be. $port is the port the user specified either on the # command line or by default. =~ is the Perl regular expression binding # operator and !~ is the negation of =~. Regular expressions are # enclosed between / / characters in Perl. \d matches a single digit, # \d+ matches a string of 1 or more digits, ^ specifies "beginning of # string", and $ specifies "end of string". /^\d+$/ as a regular # expression, therefore, matches integers of arbitrary length. # SO... The following line says: "If the port contains any non-digit # characters, look up the port number associated with the symbolic # name specified by the user. The lookup is done against /etc/services. if ($port !~ /^\d+$/) { ($name, $aliases, $port) = getservbyport($port, 'tcp'); } # Let the user know what port we're listening on, just in case (s)he # accidentally typed an incorrect port. print "Listening on port $port...\n"; # 'socket' creates one endpoint for a communication link (think of it as # creating a telephone. Later, someone else will create another telephone # and wires will be attached between them). The S parameter is the handle # associated with the created communication endpoint. AF_INET specifies # that we're talking using ports. AF_UNIX would specify that we'd be # communicating through special files created in the filesystem. This # is very attractive because then you can do away with the port number # business, but unfortunately AF_UNIX sockets only work on the same # machine. SOCK_STREAM sockets communicate using streams of characters. # Another possibility is unreliable datagram communication using # SOCK_DGRAM. Just stick with the parameters used here unless you # know what you're doing, because there are other implications you need # to understand for datagram communication. # In case you're wondering, the AF_INET and SOCK_STREAM symbols are # provided by the 'use Socket;' statement at the top of the file. # You do NOT want to put $'s in front of these symbols. # The 'die' causes execution to terminate with an error message ( which is # stored in $_) if the 'socket' call fails. socket(S,AF_INET,SOCK_STREAM,$protocol) || die "socket : $!"; # The 'bind' hooks your phone to the port number that was specified. # Think of all the ports as a telephone switchboard. 'bind' requires its # parameters to be in a C structure format. 'pack' smooshes things # together into a form that 'bind' can stomach. The $sockaddr thing below # says "An unsigned short, followed by a short in 'network order', # followed by a null-padded 4 character string, followed by 8 null # bytes." It's magic. Don't worry too much about it. $sockaddr = 'S n a4 x8'; $this = pack($sockaddr, AF_INET, $port, "\0\0\0\0"); bind(S, $this) || die "bind : $!"; # The following arranges to queue up as many as 10 clients until we # have a chance to service them. If more than 10 clients "get in line", # the excess may receive "connection refused" errors. listen(S,10) || die "listen: $!"; # Select S temporarily as the default output channel, turn on # autoflushing, then select standard output again. select(S); $| = 1; select(STDOUT); # Create connections as clients "arrive". $con maintains the connection # number of the last client for ($con = 1; ; $con++) { # Let the user know we're waiting for a connection... printf("Waiting for connection %d....\n", $con); # 'accept' blocks until it notices that a connection has been made # to our socket S. When this occurs, the incoming connection is # actually attached to the socket NS rather than S, thus leaving # S free for other incoming connections. # One more time, said another way: # # When we hear the the telephone S ringing, we quickly transfer # the call to a different phone (NS) to accept the call. # This allows S to stay free for the next call. Make sense? # The value that's returned (in $addr) gives some information about # the address of the caller. ($addr = accept(NS,S)) || die $!; # Temporarily set default output to the handle NS so... select(NS); # ...so we can set autoflushing. Setting $| to a non-zero value causes # output to the currently selected output channel to be immediately # flushed. $| = 1; # Set default output back to the standard output channel select(STDOUT); # The 'fork' creates a child process to handle this client. # Remember that 'fork' returns 0 for the child and a positive number # for the parent. if (($child = fork()) == 0) { # We're the child... # unpack the information returned by 'accept' to get some # (readable) information about the client we're serving and # print it to standard output ($af,$port, $inetaddr) = unpack($sockaddr, $addr); @inetaddr = unpack('C4', $inetaddr); print "Serving connection $con @ Internet address @inetaddr\n"; # NS is the handle for the socket we're listening to; # it's connected to the current client. # reads and returns the next line of input from the # handle NS. The following while loop form is a special Perl # construct that reads input from the handle NS line by line # until the end of file is reached. Each line is placed into # the special Perl variable $_ (the Perl "default value" # variable). while () { # output stuff from client here and... print "Received from client $con: $_"; # ...and echo it back to the client, too. print NS "Server $con: $_"; } # Close the socket connection when the client goes away close(NS); # The forked server dies here print "Client went away. Forked server $con exiting...\n"; exit; } # this is where the parent returns; all we do is close the socket # connection (it's being handled by the child we fork'ed) and then # enter another iteration of the big for loop. close(NS); }