From 2b4d0cd6c4044635d61d3e17c0703279ed05bcc9 Mon Sep 17 00:00:00 2001
From: Wolfgang Kroener <wk@w8e.de>
Date: Wed, 3 Jan 2024 18:39:54 +0100
Subject: [PATCH] inital commit of .pl file

---
 dapnet2ntfy.pl | 197 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 197 insertions(+)
 create mode 100755 dapnet2ntfy.pl

diff --git a/dapnet2ntfy.pl b/dapnet2ntfy.pl
new file mode 100755
index 0000000..85a2bfb
--- /dev/null
+++ b/dapnet2ntfy.pl
@@ -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);
+}