view release on metacpan or  search on metacpan

lib/Protocol/HAP/TLV.pm  view on Meta::CPAN

			my $chunk = substr( $value, 0, 255, '' );
			$out .= pack( 'CC', $type, length($chunk) ) . $chunk;
		}
	}

	return $out;
}

# decode($data) - Decode a TLV8 buffer into a type => value hash
# The function concatenates consecutive records with the same
# type (fragmentation). It returns the empty list if the buffer
# is malformed. A malformed buffer has a truncated record header
# or a length field that points past the end of the buffer.
sub decode ($data)
{
	my %items;
	my $pos = 0;

	while ( $pos < length($data) ) {

		# Reject a truncated record header

t/conformance/hap-tlv8.t  view on Meta::CPAN

subtest '[HAP-TLV8 §1] basic record structure' => sub {
	my $encoded = Protocol::HAP::TLV::encode( 0x06, "\x01" );
	is( length($encoded), 3, 'record is type + length + value' );
	is( unpack( 'H*', $encoded ), '060101',
		'type, length and value bytes in order' );

	my $empty = Protocol::HAP::TLV::encode( 0x0A, '' );
	is( unpack( 'H*', $empty ), '0a00', 'zero-length value encodes' );
};

subtest '[HAP-TLV8 §2] fragmentation of long values' => sub {
	my $value   = 'X' x 500;
	my $encoded = Protocol::HAP::TLV::encode( 0x03, $value );

	# 500 bytes -> 255 + 245: 2 records with 2-byte headers each
	is( length($encoded), 500 + 4, 'two records for 500 bytes' );

	# The first fragment must be exactly 255 bytes
	my ( $t1, $l1 ) = unpack( 'CC', substr( $encoded, 0, 2 ) );
	is( $t1, 0x03, 'first fragment has value type' );
	is( $l1, 255,  'non-final fragment is exactly 255 bytes' );

	my ( $t2, $l2 ) = unpack( 'CC', substr( $encoded, 257, 2 ) );
	is( $t2, 0x03, 'second fragment has same type' );
	is( $l2, 245,  'final fragment carries the remainder' );

	# The decoder concatenates same-type records
	my %decoded = Protocol::HAP::TLV::decode($encoded);
	is( $decoded{0x03}, $value, 'fragments concatenated on decode' );
};

subtest '[HAP-TLV8 §8][HAP-TLV8 §8.2] 384-byte SRP key splits FF/81' =>
    sub {
	my $key     = 'K' x 384;
	my $encoded = Protocol::HAP::TLV::encode( 0x03, $key );

	is( length($encoded), 384 + 4, '384 bytes need two records' );
	is( unpack( 'C', substr( $encoded, 1, 1 ) ),
		0xFF, 'first fragment length byte is FF (255)' );
	is( unpack( 'C', substr( $encoded, 257 + 1, 1 ) ),
		0x81, 'second fragment length byte is 81 (129)' );

	my %decoded = Protocol::HAP::TLV::decode($encoded);
	is( length( $decoded{0x03} ), 384, 'round-trips to 384 bytes' );
};

subtest '[HAP-TLV8 §3] separators between list items' => sub {
	my $encoded = Protocol::HAP::TLV::encode(
		Protocol::HAP::Pairing::kTLVType_Separator(), '' );
	is( unpack( 'H*', $encoded ), 'ff00',
		'separator is type 0xFF with zero length' );