inital commit of .pl file
This commit is contained in:
Wolfgang Kroener
parent
316a8de9ba
commit
2b4d0cd6c4
197
dapnet2ntfy.pl
Executable file
197
dapnet2ntfy.pl
Executable file
|
|
@ -0,0 +1,197 @@
|
|||
#!/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.0';
|
||||
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 = 1;
|
||||
my $dapnet_timeout_read_seconds = 125;
|
||||
my $dapnet_timeout_write_seconds = 5;
|
||||
|
||||
my %rics = (
|
||||
# on pager
|
||||
'630224' => '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;
|
||||
}
|
||||
#$socket->recv($data,1024);
|
||||
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->close();
|
||||
$socket->shutdown(SHUT_RDWR);
|
||||
}
|
||||
Loading…
Reference in a new issue