#!c:/perl/bin/perl.exe

## BIIS 1200 - ETS 300 230 Parser
## version 0.1 - 1 Jan 2010
## (c) Stefano "Sinager" Sinagra IZ0MJE
## released under GNU/GPL license
## http://www.gnu.org/licenses/gpl.txt


# setting $nmea > 0 will activate parsing SDT (Short Data Text) messages looking for
# GPS fixes in NMEA format and building an OpenStreetMap url to display tx location 
$nmea = 1;
# setting debug > 0 gives more info about processed and uprocessed binary bits
$debug = 0 ;
# setting color > 0 gives colour formatted output on ANSI compliant terminals
# safer to keep "0" under Windows
$color = 0 ;

if ($color > 0){
	use Term::ANSIColor qw(:constants);
	$Term::ANSIColor::AUTORESET = 1;
	}

$bitsync = 0;
$blocks = 0;
$k = 1;

%opmodes = (
	"000" => "System function",
	"001" => "Call",
	"010" => "Acknowledgement",
	"011" => "Special function",
	"100" => "Status transfer",
	"101" => "Status transfer",
	"110" => "Reserved category",
	"111" => "Custom function" 
	);

%functions = (
	"000000" => "Emergency reset",
	"000001" => "Cancel",
	"000010" => "Clear down",
	"000011" => "Maintenance-ID",
	"000100" => "TX Key ON",
	"000101" => "TX Key OFF",
	"000110" => "Repeater ON",
	"000111" => "Repeater OFF",
	"001000" => "Emergency radio call",
	"001001" => "Priority radio call",
	"001010" => "Normal radio call",
	"001011" => "Telephone call",
	"001100" => "Broadcast radio call",
	"001101" => "Request to call back",
	"001110" => "Manual response",
	"001111" => "External addressing",
	"010000" => "Emergency Ack",
	"010001" => "Repeat Ack",
	"010010" => "General Ack",
	"010011" => "Absent/Unavailable Ack",
	"010100" => "Busy Ack",
	"010101" => "Call Back Ack",
	"010110" => "Intermediate Ack",
	"010111" => "Reject Ack",
	"011000" => "System control",
	"011001" => "Short data transfer",
	"011010" => "Dialogue data transfer",
	"011011" => "Change channel",
	"011100" => "Vote now",
	"011101" => "Status request",
	"011110" => "Mobile enable",
	"011111" => "Mobile disable"
	);
	
%country = (
	"000000" => "Other",
	"000001" => "Vatican",
	"000010" => "Portugal",
	"000011" => "Czech Rep. / Slovak Rep.",
	"000100" => "Cyprus",
	"000101" => "Switzerland",
	"000110" => "Bulgaria / Hungary / Romania",
	"000111" => "Greece",
	"001000" => "Denmark",
	"001001" => "United Kingdom",
	"001010" => "Italy",
	"001011" => "Finland",
	"001100" => "Belgium",
	"001101" => "Norway",
	"001110" => "Andorra / Faroe Is.",
	"001111" => "Germany",
	"010000" => "France",
	"010001" => "Netherlands",
	"010010" => "Sweden",
	"010011" => "Russia / IET",
	"010100" => "Yugoslavia",
	"010101" => "Poland",
	"010110" => "San Marino / Baltic Republics",
	"010111" => "Spain",
	"011000" => "Iceland",
	"011001" => "Austria",
	"011010" => "Liechtenstein",
	"011011" => "Luxembourg",
	"011100" => "Turkey",
	"011101" => "Malta / Slovenia / Croatia",
	"011110" => "Ireland",
	"011111" => "Monaco"
	);
	
sub procbyte {
		$word = "0b" . substr($lines,0,4);
		$word_b = substr($lines,0,4);
		$lines = substr($lines,4,);			
		$word_d = oct($word);
		$word_h = sprintf('%#x', $word_d);
		$word_d = sprintf('%02d', $word_d);
		$decstring = $decstring . " " . $word_d;
		$hexstring = $hexstring . $word_h;
		$hexstring =~ s/(0x)//g;
		$binstring = $binstring . " " . $word_b;
		$digstring = $hexstring;
		$digstring =~ s/a/<A>/g;
		$digstring =~ s/b/\*/g;
		$digstring =~ s/c/\#/g;
		$digstring =~ s/d/<D>/g;
		$digstring =~ s/e/<E>/g;
		$digstring =~ s/f/< >/g;
		if ($debug > 1){print "HEX buildup: $hexstring\n";}		
	}	

sub redundant {
		$red_string = substr($lines,0,16);
		$lines = substr($lines,16,);
		if ($debug > 0){print "[REDUNDAN] ignored $red_string\n";}		
	}	
		
open (DUMP, "$ARGV[0]") || die "couldn't open the file!";
undef $/;
$lines = <DUMP>;
$lines =~ s/\s//g;
close(DUMP);
$/ = "\n";


++$blocks while $lines =~ /1010101010101011010000110011/g;
++$blocks while $lines =~ /0101010101010100101111001100/g;

if ($color > 0){print BOLD RED "\nBlocks found: $blocks\n\n";}
else {print "Blocks found: $blocks\n";}

while ($k <= $blocks){
print "\n-------------------------------------------------------\n";

if ($color > 0){print BOLD YELLOW ON_MAGENTA "Block: $k\n\n";}
else {print "Block: $k\n";}
if (($k > 1) and ($debug > 0)){print "Unprocessed bits from previous block have been dumped.\n";}

$lines =~ /1010101010101011010000110011/;
if ($& eq "1010101010101011010000110011"){
	$bitsync = 1;
	print "[BITSYNC ][BLCSYNC ] (no FEC) ";
	if ($debug > 0){print $&};
	print "\n";
	$lines = $' ;
	}
$lines =~ /0101010101010100101111001100/;
if ($& eq "0101010101010100101111001100"){
	$bitsync = 2;
	print "[BITSYNC ][BLCSYNC ] (FEC) ";
	if ($debug > 0){print $&};
	print "\n";
	$lines = $' ;
	}
		
if ($bitsync > 0){
	$omc_cat = substr($lines,0,3);
	$omc_fnc = substr($lines,0,6);
	$reg_code = substr($lines,6,6);
	$com_add =  "0b" . substr($lines,12,12);
	$tx_add = "0b" . substr($lines,24,12);
	$rx_add = "0b" . substr($lines,36,12);
	$omc1 = $opmodes{$omc_cat};
	$fnc1 = $functions{$omc_fnc};
	$ctry = $country{$reg_code};
	$redun = substr($lines,48,16);
	$lines = substr($lines,64,);

	print "[OPMODE  ] ";
	if ($color > 0){print BOLD "$omc1 ";}
	else {print "$omc1 ";} 
	if ($debug > 0){print $omc_cat};
	print "\n";

	print "[FUNCTION] ";
	if ($color > 0){print BOLD "$fnc1 ";}
	else {print "$fnc1 ";}
	
	if ($debug > 0){print substr($omc_fnc,3,)};
	if ($omc_fnc eq "001111"){print "\n           look at next function code for real msg nature"} 
	print "\n";

	print "[COUNTRY ] ";
	if ($color > 0){print BOLD "$ctry ";}
	else {print "$ctry ";}	
	if ($debug > 0){print $reg_code};
	print "\n";

	$com_add_d = oct($com_add);
	$com_add_h = sprintf('%#x', $com_add_d);
	$com_add_d = sprintf('%04d', $com_add_d);
	print "[COM ADD1] ";

	if ($color > 0){print BOLD "$com_add_d / $com_add_h ";}
	else {print "$com_add_d / $com_add_h ";}		
	if ($debug > 0){print $com_add};
	print "\n";

	$tx_add_d = oct($tx_add);
	$tx_add_h = sprintf('%#x', $tx_add_d);
	$tx_add_d = sprintf('%04d', $tx_add_d);
	$tx_add_cri = $com_add_h . $tx_add_h;
	$tx_add_cri =~ s/(0x)//g;
	$tx_add_cri = hex($tx_add_cri);

	
	print "[FROM    ] ";
	if ($color > 0){print BOLD "$tx_add_d / $tx_add_h ";}
	else {print "$tx_add_d / $tx_add_h ";}			
	if ($debug > 0){print $tx_add};
	print "\n[FRM(EXT)] $tx_add_cri ";
	
	print "\n";

	$rx_add_d = oct($rx_add);
	$rx_add_h = sprintf('%#x', $rx_add_d);
	$rx_add_d = sprintf('%04d', $rx_add_d);

	print "[REDUNDAN] ignored ";
	if ($debug > 0){print $redun};
	print "\n";

	# bits after the first address block have different meaning in case external
	# adressing is used 
	if($rx_add_d == 4095){
		# getting next 48 bits
		$omc_cat2 = substr($lines,0,3);
		$omc_fnc2 = substr($lines,0,6);
		$reg_code2 = substr($lines,6,6);
		$com_add2 =  "0b" . substr($lines,12,12);
		$tx_add2 = "0b" . substr($lines,24,12);
		$rx_add2 = "0b" . substr($lines,36,12);
		$lines = substr($lines,48,);
		redundant;
		# translatng OMC, FNC and country in human readable form
		$omc2 = $opmodes{$omc_cat2};
		$fnc2 = $functions{$omc_fnc2};
		$ctry2 = $country{$reg_code2};
		# print real function code
		print "[OPMODE  ] ";
		if ($color > 0){print BOLD "$omc2 ";}
		else {print "$omc2 ";}		
		if ($debug > 0){print $omc_cat2};
		print "\n";
		print "[FUNCTION] ";
		if ($color > 0){print BOLD "$fnc2 ";}
		else {print "$fnc2 ";}		
		if ($debug > 0){print substr($omc_fnc2,3,)};
		print "\n";
		# format and print "TO" in external addresing mode
		# common address part, used as extended addressing in some cases
		$com_add2_d = oct($com_add2);
		$com_add2_h = sprintf('%#x', $com_add2_d);
		$com_add2_d = sprintf('%04d', $com_add2_d);
		print "[COM ADD2] ";
		if ($color > 0){print BOLD "$com_add2_d / $com_add2_h ";}
		else {print "$com_add2_d / $com_add2_h ";}		
		if ($debug > 0){print $com_add2};
		print "\n";
		# from
		if ($debug > 0){
			$tx_add2_d = oct($tx_add2);
			$tx_add2_h = sprintf('%#x', $tx_add2_d);
			$tx_add2_d = sprintf('%04d', $tx_add2_d);
			print "[FROM    ] ";
			if ($color > 0){print BOLD "$tx_add2_d / $tx_add2_h ";}
			else {print "$tx_add2_d / $tx_add2_h ";}		
			print $tx_add2;
			print "\n";
			}
		$rx_add2_d = oct($rx_add2);
		$rx_add2_h = sprintf('%#x', $rx_add2_d);
		$rx_add2_d = sprintf('%04d', $rx_add2_d);
		$rx_add_cri = $com_add2_h . $rx_add2_h;
		$rx_add_cri =~ s/(0x)//g;
		$rx_add_cri = hex($rx_add_cri);
		print "[TO      ] ";
		
		if ($color > 0){print BOLD "$rx_add2_d / $rx_add2_h ";}
		else {print "$rx_add2_d / $rx_add2_h ";}
		
		print "\n[TO (EXT)] $rx_add_cri ";		
		
		if ($debug > 0){print $rx_add2};
			print "\n";
			}
		else {
			print "[TO      ] ";
			if ($color > 0){print BOLD "$rx_add_d / $rx_add_h ";}
			else {print "$rx_add_d / $rx_add_h ";}		
			if ($debug > 0){print $rx_add};
			print "\n";
			}	

	# decoding short data transfer information
	if (($omc_fnc eq "011001") or ($omc_fnc2 eq "011001")){
			print "Processing Short Data Transfer\n";
			$ncw = "0b" . substr($lines,0,4);
			$ncw_d = oct($ncw);
			$ncw_h = sprintf('%#x', $ncw_d);
			$ncw_d = sprintf('%02d', $ncw_d);
			if ($debug > 0){print "Data blocks following first: $ncw_d / $ncw_h / $ncw\n";}
			$lines = substr($lines,4,);
			$decstring = "";
			$hexstring = "";
			$digstring = "";
			# decode the first codeword (44 bits only)
			for ($z=0;$z < 11;$z++){
				procbyte;
				if ($debug > 1){print "$z ";}
				}
			redundant;
			# decode the $ncw_d codewords, 48 bits each
			for ($y=0;$y < $ncw_d ;$y++){
				for ($z=0;$z < 12;$z++){procbyte;}
				redundant;
				}
			$msgbuf = $hexstring;
			$msgbuf = substr($hexstring,1,);
			$sms = "";
			for ($w=0;$w<length($msgbuf);$w=$w+2){
					$letter = hex(substr($msgbuf,$w,2));
					$sms = $sms . chr($letter);
				}
			print "$sms\n";
			if ($debug > 0){
				print "Decimal:\n$decstring\n";
				print "Hex:\n$hexstring\n";
				print "Digits:\n$digstring\n";
				}
			if ($debug > 1 ){print "Bin:\n$binstring\n";}

			# check is sms contains a NMEA sentence
			if ($nmea > 0){
				# look for $GPRMC sentence
				$gps_sent = substr($sms,1,5);
				if($gps_sent eq "GPRMC"){
					@location = split(/,/,$sms);
					$lat_deg = $location[3];
					$lat_hem = $location[4];
					$lon_deg = $location[5];
					$lon_hem = $location[6];
					$gp_time = substr($location[1],0,6);
					}
				# look for $GPGGA sentence
				if($gps_sent eq "GPGGA"){
					@location = split(/,/,$sms);
					$lat_deg = $location[2];
					$lat_hem = $location[3];
					$lon_deg = $location[4];
					$lon_hem = $location[5];
					$gp_time = substr($location[1],0,6);
					}
				$coord_check = 0;
				$time_check = 0;
				++$coord_check while $lat_deg =~ /\d{4}\.\d{4}/g;
				++$coord_check while $lat_hem =~ /(N|S)/g;
				++$coord_check while $lon_deg =~ /\d{5}\.\d{4}/g;
				++$coord_check while $lon_hem =~ /(E|W)/g;
				if ($coord_check == 4){
					# print coordinates and build OSM url if valid coordinates found
					# convert LAT and LON in decimal
					$lat_deg = sprintf("%.6f",substr($lat_deg,0,2) + (substr($lat_deg,2,)/60));
					if($lat_hem eq "S"){$lat_deg = $lat_deg * -1};
					$lon_deg = sprintf("%.6f",substr($lon_deg,0,3) + (substr($lon_deg,3,)/60));
					if($lon_hem eq "W"){$lon_deg = $lon_deg * -1};					
					print "coordinates: lat $lat_deg ($lat_hem) / lon $lon_deg ($lon_hem)\n";
					$osmurl="http://www.openstreetmap.org/index.html?mlat=" .$lat_deg . "&mlon=" .$lon_deg . "&zoom=12";
					print "$osmurl\n";
					# print GPS derived timestamp
					++$time_check while $gp_time =~ /\d{6}/g;
					$gp_time = substr($gp_time,0,2) . ":" . substr($gp_time,2,2) . ":" . substr($gp_time,4,2);
					if ($time_check == 1){print "time: $gp_time\n";}
					}
				else {print "GPS data is corrupted\n";}
				}
			}
	
	}           
	
else {print ">>> no [BITSYNC][BLCSYNC] found, terminating\n";}

if ($debug > 0 ){print "The following bits have not been processed (yet):\n";
	print "$lines"};
$k++;}