view release on metacpan or  search on metacpan

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

	# must not invent one
	my $controller_id = $args{controller_id}
	    // die 'controller_id required';

	my $self = bless {
		host      => $args{host}   // '127.0.0.1',
		port      => $args{port}   // 51827,
		pin       => $args{pin}    // '031-45-154',
		logger    => $args{logger} // Protocol::HAP->null_logger,
		transport => $args{transport},

		# Socket read timeout. The default is correct for fast
		# in-process and native runs. A caller that talks to a
		# slow accessory raises it.
		timeout => $args{timeout} // 5,

		controller_id => $controller_id,

		# The session frame codec, with the key roles swapped
		# relative to the accessory. pair_verify turns its
		# encryption on.
		session => Protocol::HAP::Session->new( id => 0 ),

		socket     => undef,
		inbuf      => '',
		rawbuf     => '',
		last_error => undef,
	}, $class;

	# Controller long-term identity. new makes it once.
	# pair_setup later fills in accessory_ltpk and accessory_id.
	( $self->{ltsk}, $self->{ltpk} ) =
	    Protocol::HAP::Crypto->ed25519_keypair;

	return $self;
}

# $self->last_error():
#	Return the TLV error code or message string of the last
#	failed exchange.
sub last_error ($self)
{
	return $self->{last_error};
}

sub is_encrypted ($self)
{
	return $self->{session}->is_encrypted;
}

# --- transport ---------------------------------------------------------

sub _connect ($self)
{
	return 1 if $self->{transport} || $self->{socket};

	my $socket = IO::Socket::INET->new(
		PeerAddr => $self->{host},
		PeerPort => $self->{port},
		Proto    => 'tcp',
		Timeout  => $self->{timeout},
	);
	unless ( defined $socket ) {
		$self->{last_error} = "connect: $!";
		return;
	}

	$self->{socket} = $socket;
	return 1;
}

sub close ($self)
{
	if ( $self->{socket} ) {
		$self->{socket}->close;
		$self->{socket} = undef;
	}

	# A fresh session: no keys, no counters, no encryption
	$self->{session} = Protocol::HAP::Session->new( id => 0 );
	$self->{inbuf}   = '';
	$self->{rawbuf}  = '';
	return 1;
}

# $self->_round_trip($request_bytes):
#	Send the raw bytes and return the plaintext of one HTTP
#	response. On an encrypted session, the raw bytes accumulate
#	in rawbuf and every complete frame decrypts exactly once
#	through the session, so the nonce counter stays in sync.
sub _round_trip ( $self, $request )
{
	if ( $self->{transport} ) {
		my $raw = $self->{transport}->($request);
		return $raw unless $self->is_encrypted;
		return      unless defined $raw;
		$self->{rawbuf} .= $raw;
		return $self->_drain_frames;
	}

	return unless $self->_connect;

	my $socket = $self->{socket};
	$socket->syswrite($request);

	# Read until the buffer holds a full, decodable HTTP response
	my $select = IO::Select->new($socket);
	my $plain  = '';
	while (1) {
		last unless $select->can_read( $self->{timeout} );
		my $bytes = $socket->sysread( my $chunk, 65535 );
		unless ($bytes) {
			$self->{last_error} = 'connection closed';
			last;
		}

		if ( $self->is_encrypted ) {
			$self->{rawbuf} .= $chunk;
			my $drained = $self->_drain_frames;
			unless ( defined $drained ) {
				$self->{last_error} =