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