view release on metacpan or  search on metacpan

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

# $self->clear_pairing_state($session):
#	Reset the pairing lock. The server calls this after successful
#	pairing or on connection close.
sub clear_pairing_state ( $self, $session = undef )
{
	# Clear the state only if this session owns the lock or
	# the caller gives no session
	if (       !defined $session
		|| !defined $self->{pairing_session_id}
		|| $self->{pairing_session_id} == $session )
	{
		$self->{pairing_in_progress} = 0;
		$self->{pairing_session_id}  = undef;
	}

	return;
}

# $self->reset_auth_attempts:
#	Reset the failed authentication counter. The server calls this
#	after the SRP proof verification succeeds. Administrative
#	actions also call it.
sub reset_auth_attempts ($self)
{
	$self->{failed_auth_attempts} = 0;
	$self->{store}->set_auth_attempts(0);

	return;
}

# $self->_auth_failure($message):
#	Count and persist a failed attempt (§8), log it with the
#	attempt count, and return the M4 error response: MaxTries at
#	the limit, Authentication below it.
sub _auth_failure ( $self, $message )
{
	$self->{failed_auth_attempts}++;
	$self->{store}->set_auth_attempts( $self->{failed_auth_attempts} );

	$self->{logger}->warning(
		'%s (attempt %d/%d)',
		$message, $self->{failed_auth_attempts},
		MAX_AUTH_ATTEMPTS
	);

	if ( $self->{failed_auth_attempts} >= MAX_AUTH_ATTEMPTS ) {
		return $self->_error_response( kTLVError_MaxTries, 4 );
	}
	return $self->_error_response( kTLVError_Authentication, 4 );
}

# $self->get_failed_attempts:
#	Get the current failed attempt count (for testing).
sub get_failed_attempts ($self)
{
	return $self->{failed_auth_attempts};
}

# $self->_decode_request($body, $label):
#	The decode-and-check preamble of both pairing endpoints.
#	Return the request TLV as a hash reference and the state, or
#	the empty list for a malformed TLV or a missing State
#	([HAP-TLV8 §10]).
sub _decode_request ( $self, $body, $label )
{
	my %request = Protocol::HAP::TLV::decode($body);

	unless ( defined $request{ kTLVType_State() } ) {
		$self->{logger}
		    ->warning( '%s rejected: malformed TLV request', $label );
		return;
	}

	return ( \%request, unpack( 'C', $request{ kTLVType_State() } ) );
}

sub handle_pair_setup ( $self, $body, $session )
{
	my ( $request, $state ) = $self->_decode_request( $body, 'Pair-setup' );
	return $self->_error_response( kTLVError_Unknown, 2 ) unless $request;

	my $method = unpack( 'C', $request->{ kTLVType_Method() } // "\x00" );
	$self->{logger}
	    ->debug( 'Pair-setup M%d received (method=%d)', $state, $method );

	# Validate the method (0x00 = PairSetup, 0x01 = PairSetupWithAuth)
	if ( $method != 0 && $method != 1 ) {
		return $self->_error_response( kTLVError_Unknown, 2 );
	}

	if ( $state == 1 ) {
		return $self->_pair_setup_m1_m2( $session, $method );
	}
	elsif ( $state == 3 ) {
		return $self->_pair_setup_m3_m4( $request, $session );
	}
	elsif ( $state == 5 ) {
		return $self->_pair_setup_m5_m6( $request, $session );
	}

	return $self->_error_response( kTLVError_Unknown, 2 );
}

sub _pair_setup_m1_m2 ( $self, $session, $method = 0 )
{
	# Check if the failed attempts exceed the maximum
	# (HAP-Pairing.md §8)
	if ( $self->{failed_auth_attempts} >= MAX_AUTH_ATTEMPTS ) {
		$self->{logger}
		    ->warning('Pair-setup rejected: max attempts exceeded');
		return $self->_error_response( kTLVError_MaxTries, 2 );
	}

	# Check if the accessory is already paired
	# (HAP-Pairing.md §2.4). PairSetupWithAuth (method=1)
	# permits pairing even when the accessory is already
	# paired.
	if ( $method == 0 ) {
		my $pairings = $self->{store}->load_pairings();
		if ( keys %$pairings > 0 ) {