App-OpenHAP
7 results

 view release on metacpan or  search on metacpan

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

}

# $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 );

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

use Protocol::HAP::Bridge;
use Protocol::HAP::Characteristic;
use Protocol::HAP::SetupCode qw(normalize_setup_code);

# Protocol::HAP::Server - the sans-IO HAP accessory-server engine.
#
# The engine consumes bytes and emits bytes. The host owns sockets,
# timers, logging, and persistence, injected through the contracts
# that Protocol/HAP.pod documents. The engine owns everything that is
# protocol: the read buffer and its bound, decryption, HTTP parsing,
# endpoint dispatch, the pairing state machines, the accessory
# database, and event delivery.

# The largest request the engine accepts: the header block plus the
# body that Content-Length declares. An unpaired client reaches
# /pair-setup, so the buffer of an unauthenticated connection needs a
# bound of its own. A HAP request is a small TLV or a short JSON
# document, so 64 KB is far above anything a controller sends.
use constant MAX_REQUEST_SIZE => 65536;

# The HAP status code for a request that arrives on an unverified

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

{
	return _response(
		status  => 200,
		headers => { 'Content-Type' => 'application/pairing+tlv8' },
		body    => $body,
	);
}

# _char_status($aid, $iid, $code):
#	One per-characteristic result entry for the characteristics
#	endpoints [HAP-HTTP].
sub _char_status ( $aid, $iid, $code )
{
	return { aid => $aid + 0, iid => $iid + 0, status => $code };
}

# $class->new(%args):
#	name, pin, setup_id, category - the accessory identity.
#	store, logger, output, after, cancel, on_pairing_changed - the
#	host contracts of Protocol/HAP.pod. store and output are
#	required; after and cancel are optional, and without them the

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

	my $paired = $self->is_paired ? 1 : 0;
	return if $self->{last_paired_state} == $paired;

	$self->{last_paired_state} = $paired;
	$self->{on_pairing_changed}->($paired)
	    if $self->{on_pairing_changed};

	return;
}

# --- endpoint dispatch ----------------------------------------------------

sub _dispatch ( $self, $request, $session )
{
	my $path   = $request->{path};
	my $method = $request->{method};

	# Pairing endpoints. These need no verified session.
	if ( $path eq '/pair-setup' && $method eq 'POST' ) {
		return $self->_handle_pair_setup( $request, $session );
	}

	if ( $path eq '/pair-verify' && $method eq 'POST' ) {
		return $self->_handle_pair_verify( $request, $session );
	}

	# Identify endpoint. It is for unpaired accessories only.
	if ( $path eq '/identify' && $method eq 'POST' ) {
		return $self->_handle_identify( $request, $session );
	}

	# All other endpoints need a verified session. The 470 code
	# carries a reason phrase that only HAP defines, so the codec
	# does not know it.
	unless ( $session->is_verified ) {
		return _response(
			status      => STATUS_INSUFFICIENT_PRIVILEGES,
			status_text => 'Connection Authorization Required',
			headers => { 'Content-Type' => 'application/hap+json' },
		);
	}

	# Pairings management
	if ( $path eq '/pairings' && $method eq 'POST' ) {
		return $self->_handle_pairings( $request, $session );
	}

	# Accessory endpoints
	if ( $path eq '/accessories' && $method eq 'GET' ) {
		return $self->_handle_accessories( $request, $session );
	}

	# Remove the query string for path matching
	my $base_path = $path;
	$base_path =~ s/\?.*//;

	if ( $base_path eq '/characteristics' && $method eq 'GET' ) {
		return $self->_handle_characteristics_get( $request, $session );

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


	return _response(
		status  => 200,
		headers => { 'Content-Type' => 'application/hap+json' },
		body    => $json,
	);
}

# $self->_resolve_char($aid, $iid):
#	The accessory-then-characteristic lookup that both
#	characteristics endpoints perform.
sub _resolve_char ( $self, $aid, $iid )
{
	my $accessory = $self->{bridge}->get_accessory($aid);
	return unless $accessory;

	return $accessory->get_characteristic($iid);
}

sub _handle_characteristics_get ( $self, $request, $ )
{

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

	elsif ( $method == 5 ) {
		return $self->_handle_list_pairings( \%tlv, $session );
	}

	# Unknown method
	return $self->_pairings_error(
		Protocol::HAP::Pairing::kTLVError_Unknown() );
}

# $self->_pairings_error($code):
#	One failure response for the pairings endpoints.
sub _pairings_error ( $self, $code )
{
	return _tlv_response(
		Protocol::HAP::TLV::encode(
			Protocol::HAP::Pairing::kTLVType_State(),
			pack( 'C', 2 ),
			Protocol::HAP::Pairing::kTLVType_Error(),
			pack( 'C', $code ),
		) );
}

# $self->_require_admin($session):
#	The admin check of the pairings endpoints (HAP-Pairing.md §7).
#	Return the loaded pairings when the session's controller is an
#	admin, or undef.
sub _require_admin ( $self, $session )
{
	my $pairings = $self->{store}->load_pairings;
	my $current  = $pairings->{ $session->controller_id };
	return unless $current && $current->{permissions};

	return $pairings;
}

lib/Protocol/HAP/Server.pod  view on Meta::CPAN 

    # On disconnect
    $engine->session_close($session);

=head1 DESCRIPTION

This module is the HAP accessory server as a sans-IO engine: it
consumes bytes and emits bytes. The host owns sockets, timers,
logging, and persistence, injected through the contracts that
L<Protocol::HAP> documents. The engine owns everything that is
protocol: the read buffer and its 64 KB bound, decryption, HTTP
parsing, the endpoint dispatch, the pairing state machines, the
accessory database, and event delivery.

The endpoints are C</pair-setup>, C</pair-verify>, C</identify>,
C</pairings> (add, remove, list), C</accessories>,
C</characteristics> GET and PUT, and C</prepare>.

=head1 CONSTRUCTOR

C<new> takes the identity arguments C<name>, C<pin>, C<setup_id>, and
C<category> (default 2, a bridge), and the host contracts:

=over 4

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

		for my $svc ( @{ $acc->{services} } ) {
			for my $char ( @{ $svc->{characteristics} } ) {
				return ( $acc->{aid}, $char->{iid} )
				    if $char->{type} eq $type;
			}
		}
	}
	return;
}

subtest '[HAP-HTTP §1] endpoints require a verified session' => sub {
	my $hap        = make_hap();
	my $unverified = $hap->session_open;

	for my $probe (
		[ 'POST', '/pairings' ],
		[ 'GET',  '/accessories' ],
		[ 'GET',  '/characteristics?id=1.1' ],
		[ 'PUT',  '/characteristics' ],
		[ 'PUT',  '/prepare' ],
	    )
	{
		my ( $status, undef, undef ) =
		    dispatch( $hap, @$probe, undef, $unverified );
		is( $status, 470,
			"[HAP-HTTP §13.4] @$probe returns 470 "
			    . 'without pair-verify' );
	}

	# Pairing endpoints do not need a verified session
	my $m1 = Protocol::HAP::TLV::encode(
		Protocol::HAP::Pairing::kTLVType_State(),  pack( 'C', 1 ),
		Protocol::HAP::Pairing::kTLVType_Method(), pack( 'C', 0 ),
	);
	my ( $status, undef, undef ) =
	    dispatch( $hap, 'POST', '/pair-setup', $m1, $unverified );
	is( $status, 200,
		'[HAP-HTTP §4] POST /pair-setup open to unverified sessions'
	);

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


	my $m1 = Protocol::HAP::TLV::encode(
		Protocol::HAP::Pairing::kTLVType_State(),  pack( 'C', 1 ),
		Protocol::HAP::Pairing::kTLVType_Method(), pack( 'C', 0 ),
	);
	my ( undef, $headers, undef ) =
	    dispatch( $hap, 'POST', '/pair-setup', $m1,
		$hap->session_open );
	is( $headers->{'content-type'},
		'application/pairing+tlv8',
		'pairing endpoints use application/pairing+tlv8' );

	( undef, $headers, undef ) = dispatch( $hap, 'GET', '/accessories' );
	is( $headers->{'content-type'},
		'application/hap+json',
		'accessory endpoints use application/hap+json' );
};

subtest '[HAP-HTTP §3] POST /identify paired vs unpaired' => sub {
	my $hap = make_hap();
	my $unverified = $hap->session_open;

	my ( $status, undef, undef ) =
	    dispatch( $hap, 'POST', '/identify', undef, $unverified );
	is( $status, 204, 'unpaired identify returns 204 No Content' );

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

	is( $json->decode($body)->{status}, 0, 'prepare status 0' );

	# Missing ttl/pid -> -70410 invalid value
	( $status, undef, $body ) =
	    dispatch( $hap, 'PUT', '/prepare', '{}', $session );
	is( $status, 400, 'missing ttl/pid rejected' );
	is( $json->decode($body)->{status},
		-70410, 'missing ttl/pid has status -70410' );

	# The server also accepts POST. The spec shows POST in the
	# endpoint table.
	( $status, undef, undef ) =
	    dispatch( $hap, 'POST', '/prepare', $prepare, $session );
	is( $status, 200, 'POST /prepare also accepted' );
};

subtest '[HAP-HTTP §6][HAP-Pairing §7][HAP-Pairing §7.1] add pairing' =>
    sub {
	my $hap = make_hap();
	$hap->{store}->save_pairing( 'admin-ctrl', 'A' x 32, 1 );
	$hap->{store}->save_pairing( 'user-ctrl',  'U' x 32, 0 );

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

	);
	( $status, undef, $body ) = dispatch( $hap, 'POST', '/pairings',
		$remove_admin, verified_session( $hap, 'admin-ctrl' ) );
	%tlv = Protocol::HAP::TLV::decode($body);
	ok( !exists $tlv{ Protocol::HAP::Pairing::kTLVType_Error() },
		'removing last admin succeeds' );
	is( scalar keys %{ $hap->{store}->load_pairings() },
		0, 'all pairings removed with the last admin' );
};

subtest '[HAP-HTTP §13][HAP-HTTP §13.2] unknown endpoint returns 404' =>
    sub {
	my $hap = make_hap();
	my ( $status, undef, undef ) =
	    dispatch( $hap, 'GET', '/no-such-endpoint' );
	is( $status, 404, 'unknown endpoint returns 404' );
};

subtest '[HAP-HTTP §15][HAP-HTTP §15.1] JSON value encoding' => sub {
	my $hap = make_hap();
	my ( undef, undef, $acc_body ) =
	    dispatch( $hap, 'GET', '/accessories' );
	my ( $aid, $iid ) = find_char( $json->decode($acc_body), '25' );

	# A bool encodes as JSON true/false, not 1/0
	my ( undef, undef, $body ) =

t/openhap/integration/accessories.t  view on Meta::CPAN 

#!/usr/bin/env perl
# ex:ts=8 sw=4:
# Integration test: Accessory endpoints gate on pairing state

use v5.36;
use Test::More tests => 8;
use FindBin qw($RealBin);
use lib "$RealBin/../../../lib";

use App::OpenHAP::Test::Integration;

my $env = App::OpenHAP::Test::Integration->new;
$env->setup;

t/openhap/integration/accessories.t  view on Meta::CPAN 

# The daemon is running, thus hapctl asks it over the control socket
# and reports "Loaded devices". With no daemon it reads the file and
# reports "Configured devices". Accept either word: the count is the
# assertion, and it must match the file whichever source answered.
my ($count) = $devices_output =~ /(?:Loaded|Configured) devices:\s*(\d+)/;
my @device_topics = $env->get_device_topics;
is($count // 0, scalar @device_topics,
   'the daemon loaded every configured device');

# The daemon starts unpaired, because the integration files own their
# pairing lifecycle. Thus the data-plane endpoints must return HTTP
# 470. The file t/openhap/integration/characteristics.t covers paired
# access.

# Test 3: GET /accessories requires pairing
my $response = $env->http_request('GET', '/accessories');
my $status = App::OpenHAP::Test::Integration::status($response);
is($status, 470,
   '[HAP-HTTP §7] GET /accessories returns 470 when unpaired');

# Test 4: GET /characteristics requires pairing

t/openhap/integration/hap-protocol.t  view on Meta::CPAN 

#!/usr/bin/env perl
# ex:ts=8 sw=4:
# Integration test: HAP protocol endpoints and HTTP functionality

use v5.36;
use Test::More tests => 16;
use FindBin qw($RealBin);
use lib "$RealBin/../../../lib";

use App::OpenHAP::Test::Integration;

my $env = App::OpenHAP::Test::Integration->new;
$env->setup;

# Test 1: The HAP server is reachable over HTTP
my $response = $env->http_request('GET', '/');
ok(defined $response && $response =~ /^HTTP\/1\.[01]/, 'server reachable');

# Test 2: /accessories endpoint responds
$response = $env->http_request('GET', '/accessories');
my $status = App::OpenHAP::Test::Integration::status($response);
ok(defined $status, '/accessories endpoint responds');

# Test 3: /accessories has correct Content-Type
my $has_content_type = $response =~ /Content-Type:\s*application\/hap\+json/i;
ok($has_content_type || $status == 470,
   '/accessories uses application/hap+json');

# Test 4: /pair-setup endpoint accepts POST
$response = $env->http_request('POST', '/pair-setup', "\x00\x01\x00",
	{'Content-Type' => 'application/pairing+tlv8'});
ok(defined $response && $response =~ /HTTP\/1\.[01]\s+200/,
   '/pair-setup accepts POST');

# Test 5: /pair-setup uses correct Content-Type
$has_content_type = $response =~ /Content-Type:\s*application\/pairing\+tlv8/i;
ok($has_content_type, '/pair-setup uses application/pairing+tlv8');

# Test 6: /pair-verify endpoint accepts POST
$response = $env->http_request('POST', '/pair-verify', "\x00\x01\x00",
	{'Content-Type' => 'application/pairing+tlv8'});
ok(defined $response && $response =~ /HTTP\/1\.[01]\s+200/,
   '/pair-verify accepts POST');

# Test 7: /pair-verify uses correct Content-Type
$has_content_type = $response =~ /Content-Type:\s*application\/pairing\+tlv8/i;
ok($has_content_type, '/pair-verify uses application/pairing+tlv8');

# Test 8: Server uses HTTP/1.x protocol

t/openhap/integration/pairing.t  view on Meta::CPAN 

    or diag('pair_setup error: ' . ($controller->last_error // 'none'));
ok(defined $controller->{accessory_ltpk},
   '[HAP-Pairing §2.8] accessory LTPK received in M6');

# Test 4: Pair-verify establishes an encrypted session
ok($controller->pair_verify,
   '[HAP-Pairing §3] pair-verify M1-M4 completes')
    or diag('pair_verify error: ' . ($controller->last_error // 'none'));
ok($controller->is_encrypted, 'session switched to encrypted framing');

# Test 5: Authenticated endpoint works over the session
my $result = $controller->request('GET', '/accessories');
is($result->{status}, 200,
   '[HAP-HTTP §7] paired GET /accessories returns 200');

# Test 6: Add, list, and remove an additional pairing over the wire
ok($controller->add_pairing('extra-ctrl', 'X' x 32, 0),
   '[HAP-Pairing §7.1] add pairing accepted');
my $pairings = $controller->list_pairings;
is(scalar @$pairings, 2, '[HAP-Pairing §7.3] both pairings listed');
ok($controller->remove_pairing('extra-ctrl'),



( run in 2.255 seconds using v1.01-cache-2.11-cpan-9789f410c06 )