App-OpenHAP

 view release on metacpan or  search on metacpan

bin/openhapd  view on Meta::CPAN

use Protocol::HAP::Crypto;
use Fugu::Daemon;
use Fugu::Log;
use Fugu::Mdnsd;
use Fugu::MQTT;
use Fugu::Privdrop;
use Fugu::Sandbox;
use Fugu::Signal;
use App::OpenHAP::Devices;
use App::OpenHAP::Host;
use Protocol::HAP::SetupCode qw(validate_setup_code);

# Default configuration
my $config_file  = '/etc/openhapd.conf';
my $foreground   = 0;
my $check_config = 0;
my $verbose      = 0;

GetOptions(
	'c|config=s'   => \$config_file,
	'f|foreground' => \$foreground,

bin/openhapd  view on Meta::CPAN

# install; a file that exists but does not parse is not, and the
# daemon must not run on defaults that the operator did not choose.
my $config = Fugu::Config->new( file => $config_file );
if ( -f $config_file && !$config->load ) {
	print STDERR $config->error . "\n";
	exit 1;
}

# Refuse an unusable setup code here, before the daemonize step. The
# engine requires a valid code, and it must not fail with a raw die
# after the process left the terminal. validate_setup_code also
# rejects the trivial codes that the HAP specification disallows.
my $hap_pin = $config->get( 'hap_pin', '1995-1018' );
unless ( validate_setup_code($hap_pin) ) {
	print STDERR "openhapd: hap_pin \"$hap_pin\" is not a valid"
	    . " setup code: use 8 digits, not a trivial pattern, for"
	    . " example 1995-1018\n";
	exit 1;
}

# Refuse an unknown log level or facility the same way, and name the
# value. openhapd.conf(5) lists exactly these spellings; a daemon
# that silently mapped an unknown one to a default would serve a
# level the operator did not choose.

bin/openhapd  view on Meta::CPAN

my $log = Fugu::Log->new(
	mode     => $log_mode,
	ident    => 'openhapd',
	level    => $verbose ? 'debug' : $log_level,
	facility => $log_facility,
);
Fugu::Log->set_default($log);

$log->info('OpenHAP daemon initializing');

# Get the HAP settings. hap_pin was read and validated above,
# before the -n exit and the daemonize.
my $hap_name = $config->get( 'hap_name', 'OpenHAP Bridge' );
my $hap_port = $config->get( 'hap_port', 51827 );
my $db_path  = $config->get( 'db_path',  '/var/db/openhapd' );

# Where hapctl asks the running daemon what it is doing. The value
# "off" turns the socket off, for an operator who wants no local
# control channel at all.
my $control_path = $config->get( 'control', '/var/run/openhapd/control.sock' );
$control_path = undef if lc $control_path eq 'off';

lib/App/OpenHAP/Devices.pm  view on Meta::CPAN

# App::OpenHAP::Devices - turn the device blocks of the configuration
# into accessories on the bridge.
#
# One table describes every device type. Each entry says what the type
# is called in a log line, which class builds it, and what that class
# needs beyond the fields every device has. Adding a type is one
# entry, and no second place to keep true.
#
# The class of the entry does the work of building. The loader only
# decides which one, validates the fields the configuration must
# carry, and subscribes the result to MQTT.
#
# A device class loads when the configuration asks for it, not at
# compile time. The classes drag JSON::XS and the whole accessory
# model behind them, and a tool that only reads the device blocks
# needs none of it. The daemon builds its devices before it pledges,
# thus the late load costs it nothing.
# The lightbulb family differs only in its capability mask, so those
# entries carry a caps field instead of one closure each. The mask
# values are the CAP_* constants of the class, spelled as numbers

lib/App/OpenHAP/Devices.pm  view on Meta::CPAN

	# the build, and the log name.
	my $entry = $DEVICE{"$dev_type/$dev_subtype"};
	unless ($entry) {
		Fugu::Log->default->debug(
			'Skipping unsupported device type: %s/%s',
			$dev_type, $dev_subtype );
		return;
	}

	# Validate the required fields
	return unless $self->_validate_device($device);

	# Create the device and catch errors
	my $accessory;
	eval {
		$accessory =
		    $self->_instantiate_device( $device, $mqtt, $entry );
	};
	if ($@) {
		Fugu::Log->default->error( 'Failed to create %s "%s": %s',
			$entry->{name}, $device->{name}, $@ );

lib/App/OpenHAP/Devices.pm  view on Meta::CPAN

			%{ $block->{settings} },
			type    => $type,
			subtype => $subtype,
			id      => $id,
		    };
	}

	return @devices;
}

# $self->_validate_device($device):
#	Validate the required device fields. The method returns true
#	if the device is valid.
sub _validate_device ( $self, $device )
{
	unless ( defined $device->{name} && $device->{name} ne '' ) {
		Fugu::Log->default->error(
			'Device missing required field: name');
		return;
	}

	unless ( defined $device->{topic} && $device->{topic} ne '' ) {
		Fugu::Log->default->error(
			'Device "%s" missing required field: topic',

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

# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

use v5.36;

package Protocol::HAP::SetupCode;
our $VERSION = '0.1.0';
use Exporter qw(import);
our @EXPORT_OK = qw(normalize_setup_code validate_setup_code);

# Protocol::HAP::SetupCode - the rules of the 8-digit setup code.
#
# The specification says "setup code" [HAP-Pairing §2]. The word PIN is
# the one it replaced, so no name here uses it.

# Invalid setup codes per HAP specification
# These are sequential or trivial patterns. Do not use them.
use constant INVALID_SETUP_CODES => qw(
    00000000 11111111 22222222 33333333 44444444

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

	# Remove the dashes and spaces
	$code =~ s/[-\s]//g;

	# Make sure the setup code is exactly 8 digits
	return unless $code =~ /^\d{8}$/;

	return $code;
}

# validate_setup_code($code):
#	Validate that the setup code meets the HAP requirements
#	Returns: 1 if the setup code is valid, undef if it is invalid
sub validate_setup_code ($code)
{
	# Normalize the setup code first
	my $normalized = normalize_setup_code($code);
	return unless defined $normalized;

	# Check the setup code against the list of invalid codes
	my %invalid = map { $_ => 1 } INVALID_SETUP_CODES;
	return if exists $invalid{$normalized};

	return 1;

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

=head1 NAME

Protocol::HAP::SetupCode - the rules of the HomeKit setup code

=head1 SYNOPSIS

    use Protocol::HAP::SetupCode qw(normalize_setup_code validate_setup_code);

    # Normalize a setup code (remove dashes and spaces)
    my $normalized = normalize_setup_code('9876-5432');  # Returns '98765432'
    my $normalized = normalize_setup_code('9876 5432');  # Returns '98765432'
    my $normalized = normalize_setup_code('98765432');   # Returns '98765432'

    # Validate a setup code
    if (validate_setup_code('9876-5432')) {
        print "Valid setup code\n";
    }

    if (!validate_setup_code('1234-5678')) {
        print "Invalid setup code (sequential pattern)\n";
    }

=head1 DESCRIPTION

This module handles HAP setup codes: the 8-digit numeric codes that
pairing uses. The specification calls them setup codes
[HAP-Pairing §2], so no name here uses the word it replaced.

The HAP specification says that dashes and spaces are format characters

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

This function removes the dashes and the spaces from a setup code. It
returns the 8-digit numeric string.

    my $normalized = normalize_setup_code('9876-5432');
    # Returns: '98765432'

The function returns C<undef> if the input format is not valid. A valid
input has exactly 8 digits after normalization.

=head2 validate_setup_code($code)

This function does a check of a setup code against these HAP
requirements:

=over 4

=item * The code must have exactly 8 digits after the removal of the
dashes and the spaces.

=item * The code must not be a trivial or sequential pattern.

=back

The function returns C<1> if the setup code is valid. It returns
C<undef> if the setup code is not valid.

    if (validate_setup_code('9876-5432')) {
        # the setup code is valid
    }

=head1 INVALID SETUP CODES

The HAP specification rejects these setup codes:

    00000000  11111111  22222222  33333333  44444444
    55555555  66666666  77777777  88888888  99999999
    12345678  87654321

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

use FindBin qw($RealBin);
use lib "$RealBin/../../../lib";

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

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

my $config_file = $env->{config_file};

# Test 1: openhapd -n validates configuration
my $daemon_check = system("openhapd -n -c $config_file >/dev/null 2>&1");
is($daemon_check, 0, 'openhapd -n validates configuration');

# Test 2: Configuration contains required HAP settings
my $hap_name = $env->get_config_value('hap_name');
my $hap_port = $env->get_config_value('hap_port');
ok(defined $hap_name, 'configuration has hap_name');
ok(defined $hap_port, 'configuration has hap_port');

# Test 3: HAP port is valid
ok($hap_port =~ /^\d+$/ && $hap_port >= 1024 && $hap_port <= 65535,
   'hap_port is valid');

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

$env->setup;

my $config_file = $env->{config_file};
my $hapctl = '/usr/local/bin/hapctl';

# Test 1: hapctl without arguments shows usage
my $no_args_output = `$hapctl 2>&1`;
my $shows_usage = $no_args_output =~ /(Usage|help|command)/i;
ok($shows_usage, 'shows usage without arguments');

# Test 2: hapctl check validates configuration
my $check_result = system("$hapctl -c $config_file check >/dev/null 2>&1");
is($check_result, 0, 'check command validates configuration');

# Test 3: hapctl check provides meaningful output
my $check_output = `$hapctl -c $config_file check 2>&1`;
my $check_meaningful = $check_output =~ /(Configuration.*valid|Configured devices:\s*\d+)/i;
ok($check_meaningful, 'check output is meaningful');

# Test 4: hapctl status reports daemon state
my $status_output = `$hapctl -c $config_file status 2>&1`;
my $status_works = $? == 0 && length($status_output) > 0;
ok($status_works, 'status command works');

t/protocol/setupcode.t  view on Meta::CPAN

{
	my $code = Protocol::HAP::SetupCode::normalize_setup_code(undef);
	is($code, undef, 'Handle undefined input');
}

{
	my $code = Protocol::HAP::SetupCode::normalize_setup_code('1234-');
	is($code, undef, 'Reject an incomplete setup code');
}

# Test validate_setup_code: valid setup codes
{
	ok(Protocol::HAP::SetupCode::validate_setup_code('9876-5432'), 'A valid setup code with a dash');
}

{
	ok(Protocol::HAP::SetupCode::validate_setup_code('98765432'), 'A valid setup code without a dash');
}

{
	ok(Protocol::HAP::SetupCode::validate_setup_code('1111-2222'), 'A valid setup code with repeated digits');
}

{
	ok(Protocol::HAP::SetupCode::validate_setup_code('0000-0001'), 'A valid setup code that starts with zeros');
}

# Test validate_setup_code: HAP disallows trivial setup codes (Apple HAP R2
# 5.3). The trivial-code blacklist is not in spec/.
{
	ok(!Protocol::HAP::SetupCode::validate_setup_code('00000000'), 'Reject 00000000');
}

{
	ok(!Protocol::HAP::SetupCode::validate_setup_code('11111111'), 'Reject 11111111');
}

{
	ok(!Protocol::HAP::SetupCode::validate_setup_code('22222222'), 'Reject 22222222');
}

{
	ok(!Protocol::HAP::SetupCode::validate_setup_code('33333333'), 'Reject 33333333');
}

{
	ok(!Protocol::HAP::SetupCode::validate_setup_code('44444444'), 'Reject 44444444');
}

{
	ok(!Protocol::HAP::SetupCode::validate_setup_code('55555555'), 'Reject 55555555');
}

{
	ok(!Protocol::HAP::SetupCode::validate_setup_code('66666666'), 'Reject 66666666');
}

{
	ok(!Protocol::HAP::SetupCode::validate_setup_code('77777777'), 'Reject 77777777');
}

{
	ok(!Protocol::HAP::SetupCode::validate_setup_code('88888888'), 'Reject 88888888');
}

{
	ok(!Protocol::HAP::SetupCode::validate_setup_code('99999999'), 'Reject 99999999');
}

{
	ok(!Protocol::HAP::SetupCode::validate_setup_code('12345678'), 'Reject 12345678');
}

{
	ok(!Protocol::HAP::SetupCode::validate_setup_code('87654321'), 'Reject 87654321');
}

# Test validate_setup_code: it must also reject invalid codes with dashes
{
	ok(!Protocol::HAP::SetupCode::validate_setup_code('0000-0000'), 'Reject 0000-0000');
}

{
	ok(!Protocol::HAP::SetupCode::validate_setup_code('1111-1111'), 'Reject 1111-1111');
}

{
	ok(!Protocol::HAP::SetupCode::validate_setup_code('1234-5678'), 'Reject 1234-5678 (sequential)');
}

{
	ok(!Protocol::HAP::SetupCode::validate_setup_code('8765-4321'), 'Reject 8765-4321 (reverse sequential)');
}

# Test validate_setup_code: malformed input
{
	ok(!Protocol::HAP::SetupCode::validate_setup_code('123-4567'), 'Reject a malformed setup code (7 digits)');
}

{
	ok(!Protocol::HAP::SetupCode::validate_setup_code('abcd-efgh'), 'Reject a non-numeric setup code');
}

{
	ok(!Protocol::HAP::SetupCode::validate_setup_code(''), 'Reject empty string');
}

{
	ok(!Protocol::HAP::SetupCode::validate_setup_code(undef), 'Reject undefined input');
}

# Test edge cases
{
	my $code = Protocol::HAP::SetupCode::normalize_setup_code('----1234----5678----');
	is($code, '12345678', 'Handle excessive dashes');
}

{
	my $code = Protocol::HAP::SetupCode::normalize_setup_code('   1234   5678   ');