# Copyright (c) 2010  Peter Pentchev
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.

# A simple tinydns-data filter to convert type 16 RR records to TXT records.

use strict;
use warnings;

sub decode_single($);
sub decode_several($ $);

while (<>) {
	my ($data, $res, $len, $part);
	my (@a);

	if (!/^:/ || !(@a = split /:/) || @a < 4 || $a[1] ne '16') {
		print;
		next;
	}

	# We have a TXT record!  Try to decode its contents...
	$a[$#a] =~ s/[\r\n]*$//;
	$data = $a[3];
	$res = '';
	while (($len, $data) = decode_single($data)) {
		if ($len =~ /^\\(\d+)$/) {
			$len = oct $1;
		} else {
			$len = unpack('C', $len);
		}
		($part, $data) = decode_several($len, $data);
		$res .= $part;
	}
	print "'".join(':', $a[2], $res, @a[4..$#a])."\n";
}

=item * decode_single (STRING)

Extract the first (possibly encoded) byte from C<STRING>.
Return a list of two elements - the first byte (still possibly encoded) and
the rest of the string.

=cut

sub decode_single($)
{
	my ($s) = @_;

	return () if !defined($s) || $s eq '';
	if ($s =~ /^(\\\d{3}|.)(.*)/) {
		return ($1, $2);
	} else {
		return ();
	}
}

=item * decode_several (LENGTH, STRING)

Extract several (possibly encoded) bytes from the beginning of C<STRING>.
Return a list of two elements - the first C<LENGTH> bytes (still possibly
encoded) and the rest of the string.

=cut

sub decode_several($ $)
{
	my ($len, $s) = @_;
	my ($idx);

	return ('', $s) if $len < 1;
	$idx = index($s, '\\');
	if ($idx == -1 || $idx >= $len) {
		return (substr($s, 0, $len), substr($s, $len));
	} else {
		# Decode the rest of the string...
		my ($part, $data) = decode_several($len - $idx - 1,
		    substr($s, $idx + 4));
		# ...then prepend the part with the first \ooo
		return (substr($s, 0, $idx + 4).$part, $data);
	}
}