dapnet2ntfy/dapnet2ntfy.pl

#!/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);
}