197 lines
4.6 KiB
Perl
Executable file
197 lines
4.6 KiB
Perl
Executable file
#!/usr/bin/env perl
|
|
|
|
# Protocol for connecting transmitters to DAPNET:
|
|
# https://hampager.de/dokuwiki/doku.php?id=dapnetprotocol
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
|
|
# configuration
|
|
my $version = '0.5.1';
|
|
my $dapnet_username = '';
|
|
my $dapnet_password = '';
|
|
my $dapnet_server = 'dapnet.afu.rwth-aachen.de';
|
|
#my $dapnet_server = 'db0dbn.ig-funk-siebengebirge.de';
|
|
my $dapnet_port = '43434',
|
|
my $ntfy_username = '';
|
|
my $ntfy_password = '';
|
|
my $ntfy_url = 'https://server/topic';
|
|
my $debug = 0;
|
|
my $dapnet_timeout_read_seconds = 125;
|
|
my $dapnet_timeout_write_seconds = 5;
|
|
|
|
my %rics = (
|
|
# on pager
|
|
# add you own RIC in next line
|
|
'' => 'PM',
|
|
'1041' => 'MOWAS',
|
|
'1063' => 'METAR',
|
|
'1064' => 'WX-Lokal',
|
|
'1080' => 'APRS-WX',
|
|
'1081' => 'DWD',
|
|
# for info
|
|
# all
|
|
'1001' => 'DAPNET-News',
|
|
'1028' => 'Clubnews',
|
|
#'1060' => 'Stats',
|
|
# dl-all
|
|
'1016' => 'DL-HH',
|
|
'1040' => 'Notfunk-DL',
|
|
'1044' => 'HAMNET',
|
|
'1055' => 'DAPNET-Team',
|
|
'1058' => 'xOTA',
|
|
# dl-hh
|
|
'1042' => 'Notfunk-Lokal',
|
|
'1083' => 'Feinstaub',
|
|
);
|
|
|
|
|
|
# start of program
|
|
use IO::Socket::INET;
|
|
use IO::Socket::Timeout;;
|
|
use Errno qw(ETIMEDOUT EWOULDBLOCK);
|
|
use HTTP::Request ();
|
|
use LWP::UserAgent;
|
|
use MIME::Base64;
|
|
use POSIX qw(strftime);
|
|
use utf8;
|
|
|
|
my $run = 1;
|
|
$SIG{INT} = sub {
|
|
print STDERR "terminating\n";
|
|
$run = 0;
|
|
};
|
|
|
|
sub debug_print {
|
|
if ($debug) {
|
|
print STDERR strftime("%F %T", localtime) . " $_[0]";
|
|
}
|
|
}
|
|
|
|
sub decode_umlauts {
|
|
# [\]{|}~ -> ÄÖÜäöüß
|
|
my $s = $_[0];
|
|
$s =~ tr/[\\]{|}~/ÄÖÜäöüß/;
|
|
utf8::encode($s);
|
|
return $s;
|
|
}
|
|
|
|
sub decode_skyper
|
|
{
|
|
# message is ROT-1 encoded
|
|
my $s = '';
|
|
foreach my $c (split('', $_[0])) {
|
|
$s = $s . chr(ord($c) - 1);
|
|
}
|
|
$s = decode_umlauts($s);
|
|
return $s;
|
|
}
|
|
|
|
# replace decimal RIC with hex value
|
|
# better to do this now, not every time a message arrives
|
|
%rics = map { sprintf("%X", $_) => $rics{$_} } keys %rics;
|
|
|
|
my $ntfy_auth_header = 'Basic ' . encode_base64($ntfy_username . ':' . $ntfy_password);
|
|
|
|
while ($run) {
|
|
debug_print "connecting to $dapnet_server\n";
|
|
my $socket = IO::Socket::INET->new(
|
|
PeerAddr => $dapnet_server,
|
|
PeerPort => $dapnet_port,
|
|
Timeout => $dapnet_timeout_read_seconds,
|
|
Proto => 'tcp',
|
|
);
|
|
if (! $socket) {
|
|
print STDERR "connection problem, reconnect\n";
|
|
next;
|
|
}
|
|
|
|
# set up timeout for reading/writing
|
|
IO::Socket::Timeout->enable_timeouts_on($socket);
|
|
$socket->read_timeout($dapnet_timeout_read_seconds);
|
|
$socket->write_timeout($dapnet_timeout_write_seconds);
|
|
|
|
my $reconnect = 0;
|
|
#my $last_received = time;
|
|
|
|
# login
|
|
$socket->send("[dapnet2ntfy v$version $dapnet_username $dapnet_password]\r\n");
|
|
while (!$reconnect) {
|
|
$reconnect = 0;
|
|
my $data = <$socket>;
|
|
if (! $data && ( 0+$! == ETIMEDOUT || 0+$! == EWOULDBLOCK )) {
|
|
print STDERR "timeout, reconnect\n";
|
|
$reconnect = 1;
|
|
next;
|
|
}
|
|
chomp $data;
|
|
debug_print "received: $data.\n" ;
|
|
if ($data =~ /^2:(.*)$/) {
|
|
# ident to server
|
|
# example: 2:00AF
|
|
$socket->send("2:$1:0000\r\n+\r\n");
|
|
} elsif ($data =~ /^([34]):.*$/) {
|
|
# time sync and time slot
|
|
# example: 3:+0090
|
|
# example: 4:048C
|
|
$socket->send("+\r\n");
|
|
if ($1 == '4') {
|
|
print STDERR "listening to $dapnet_server\n";
|
|
}
|
|
} elsif ($data =~ /^7/) {
|
|
# login failed
|
|
print STDERR "login to $dapnet_server failed:\n";
|
|
print STDERR "$data\n";
|
|
$run = 0;
|
|
} elsif ($data =~ /^#([0-9a-fA-F]+) (.*)$/) {
|
|
# messages
|
|
# example: #02 6:1:D8:3:YYYYMMDDHHMMSS231222141600
|
|
|
|
# increase counter and send it back
|
|
my $cnt = hex $1;
|
|
if ($cnt >= 255) {
|
|
# reset counter on FF
|
|
$cnt = 0;
|
|
} else {
|
|
++$cnt;
|
|
}
|
|
$socket->send('#' . sprintf("%02X", $cnt) . " +\r\n");
|
|
|
|
# parse message
|
|
my ($type, $speed, $ric, $bit, $msg) = split(/:/, $2, 5);
|
|
# ignore speed, and bit
|
|
# split only 5 times, message can contain :
|
|
if ($type == '6') {
|
|
# type 6 is for messages
|
|
if (exists($rics{$ric})) {
|
|
# ric is in wanted list
|
|
# send to ntfy
|
|
my $ua = LWP::UserAgent->new;
|
|
my $request = HTTP::Request->new(
|
|
'POST',
|
|
$ntfy_url,
|
|
[ 'Authorization' => $ntfy_auth_header ],
|
|
"DAPNET: $rics{$ric}: " . decode_umlauts($msg)
|
|
);
|
|
my $response = $ua->request($request);
|
|
} elsif ($debug && ($ric =~ /^11A[08]$/)) {
|
|
# skyper message
|
|
debug_print "Skyper message: " . decode_skyper($msg) . "\n";
|
|
}
|
|
}
|
|
} elsif ($data eq '') {
|
|
print STDERR "connection problem, reconnect\n";
|
|
$reconnect = 1;
|
|
}
|
|
#if (time - $last_received > $dapnet_timeout_read_seconds) {
|
|
# print STDERR "timeout, reconnect\n";
|
|
# $reconnect = 1;
|
|
#} else {
|
|
# $last_received = time;
|
|
#}
|
|
sleep(1);
|
|
}
|
|
$socket->shutdown(SHUT_RDWR);
|
|
}
|