Fugu

 view release on metacpan or  search on metacpan

lib/Fugu/Control.pm  view on Meta::CPAN

# The bound on one whole reply, across every frame. A control reply
# is a status line or a device list, and a megabyte is far above
# either. The bound exists so a client cannot be made to hold an
# unbounded string by a server that never stops sending.
use constant MAX_REPLY => 1048576;

# How long a client waits for one frame.
use constant DEFAULT_TIMEOUT => 5;

# The platform predicate of peer. Only OpenBSD reports the peer
# credentials in the struct sockpeercred order: the user id, then the
# group id, then the process id. The Linux struct ucred holds the
# process id first, and one module must not carry two field orders.
# The base perl of OpenBSD exports Socket::SO_PEERCRED (0x1022), so
# no compiled module is necessary.
use constant PEER_SUPPORTED => $^O eq 'openbsd';

my $JSON = JSON::PP->new->utf8->canonical;

# Fugu::Control->new(%args):
#	path => $socket		the UNIX socket to serve (required)

lib/Fugu/Control.pm  view on Meta::CPAN

	my ( $peer, $fault );
	if (PEER_SUPPORTED) {
		( $peer, $fault ) = _read_peer($client);

		# The read cannot fail on a healthy UNIX socket, so a
		# failure names a broken assumption. A control socket
		# that cannot name its peer must not answer.
		unless ($peer) {
			$self->_log->error(
				'Cannot read the peer credentials on %s: %s',
				$self->{path}, $fault );
			CORE::close $client;
			return;
		}
	}

	my $imsg = Fugu::Imsg->new( fh => $client );
	$self->{clients}{ fileno $client } = $imsg;
	$self->{peers}{ fileno $client }   = $peer;

lib/Fugu/Control.pm  view on Meta::CPAN

		return $self->_send_error( $imsg, $peerid,
			'request names no command' );
	}

	my $handler = $self->{commands}{$command};
	unless ($handler) {
		return $self->_send_error( $imsg, $peerid,
			"unknown command: $command" );
	}

	# The credentials belong to the connection. peer answers only
	# while the handler runs, so the local scope ends with the
	# call.
	my $reply = do {
		local $self->{current_peer} =
		    $self->{peers}{ fileno $imsg->{fh} };
		eval { $handler->( $request->{args} // {} ) };
	};
	if ($@) {
		my $reason = $@;
		chomp $reason;

lib/Fugu/Control.pm  view on Meta::CPAN

		peerid => $peerid,
		data   => $JSON->encode(
			{ ok => JSON::PP::false, error => $reason }
		),
	) or return 0;

	return 1;
}

# Fugu::Control->peer_supported:
#	Report if the platform gives peer credentials in the struct
#	sockpeercred order. A caller or a test uses this, not a log
#	line, to tell "not supported" from "the read failed".
sub peer_supported ($)
{
	return PEER_SUPPORTED ? 1 : 0;
}

# $self->peer:
#	The credentials of the connection that the server answers now,
#	as a hash reference with uid, gid and pid. The method returns
#	undef outside a handler call, and undef where peer_supported is
#	false. It holds no policy: the group of the socket is the
#	coarse gate, and the handler is the fine gate.
sub peer ($self)
{
	return $self->{current_peer};
}

# _read_peer($client):
#	The peer credentials of one connection, as ($peer, $fault).
#	One of the two is defined. getsockopt(2) with SO_PEERCRED
#	returns a struct sockpeercred, and the length check guards the
#	unpack.
sub _read_peer ($client)
{
	# The constant probe fails closed. The base perl of OpenBSD
	# 7.8 exports Socket::SO_PEERCRED, and a real guest verified
	# the read. Socket still croaks at call time for a constant
	# that a platform does not define, and the server must log and
	# close instead.

lib/Fugu/Control.pod  view on Meta::CPAN

mode, takes the group with chown(2), and widens to C<mode> with
chmod(2) last.
A daemon drops privileges first, and it calls C<listen> after.
A process can chgrp its own file to a group that it belongs to, so
the group form needs no root.

=item C<accept_one($loop)>

Take one connection and register it as a read handler on the loop.
Where C<peer_supported()> is true, the method reads the peer
credentials of the connection once, with getsockopt(2) and
C<SO_PEERCRED>.
A credential read that fails closes the connection at once, and the
server logs the reason at the error level: a control socket that
cannot name its peer must not answer.

=item C<peer()>

The credentials of the connection that the server is answering now,
as a hash reference with C<uid>, C<gid> and C<pid>: the effective
user id, the effective group id, and the process id of the peer.
A handler that needs the operator identity calls it, and a handler
that does not need it ignores it.

The method returns C<undef> outside a handler call, and C<undef>
where C<peer_supported()> is false.
It holds no policy and reports three numbers.
The group of the socket is the coarse gate, and the handler is the
fine gate.

On OpenBSD the read returns a C<struct sockpeercred>, which holds the
user id, then the group id, then the process id.
The field order differs from the Linux C<struct ucred>, which holds
the process id first, and one module must not carry two field orders.
The method therefore reads the credentials on OpenBSD only, and it
reports "not supported" everywhere else, through C<peer_supported()>.

=item C<peer_supported()>

A class method.
It returns true only where the platform reports peer credentials in
the C<struct sockpeercred> order.
A caller or a test uses it to tell "not supported" from "the read
failed".

=item C<shutdown(%args)>

Close every connection, close the listener, and remove the socket.
A socket left behind names a daemon that is not there.

=item C<path()>

lib/Fugu/MQTT.pm  view on Meta::CPAN

				require Net::MQTT::Simple;

				my $server = $self->{host};
				if ( $self->{port} != 1883 ) {
					$server .= ':' . $self->{port};
				}

				my $mqtt = Net::MQTT::Simple->new($server);

				# Set the login credentials if the
				# configuration has a username
				if ( defined $self->{username} ) {
					$mqtt->login(
						$self->{username},
						$self->{password} // ''
					);
				}

				$self->{client}    = $mqtt;
				$self->{connected} = 1;

lib/Fugu/MQTT.pod  view on Meta::CPAN

=item C<host>

The broker. The default is 127.0.0.1.

=item C<port>

The broker port. The default is 1883.

=item C<username>

The login name. The client sends no credentials when this argument is
absent.

=item C<password>

The login password.

=back

=head2 mqtt_connect

t/fugu/control.t  view on Meta::CPAN

	}
	elsif ( defined eval { Socket::SO_PEERCRED() } ) {

		# The platform defines the constant with an other
		# field order, so only the fail-closed shape holds
		# here. The fabricated-bytes subtest below locks the
		# unpack itself.
		ok( defined $peer || defined $fault, 'one of the two answers' );
	}
	else {
		is( $peer, undef, 'no credentials come back' );
		like( $fault, qr/SO_PEERCRED/,
			'and the reason names the constant' );
	}

	close $a_end;
	close $b_end;
};

subtest 'the credential unpack keeps a large id positive' => sub {

t/fugu/control.t  view on Meta::CPAN

subtest 'peer answers only inside a handler' => sub {
	my $control = Fugu::Control->new( path => "$dir/peer.sock" );
	is( $control->peer, undef, 'peer is undef outside a handler' );

	is( Fugu::Control->peer_supported,
		$^O eq 'openbsd' ? 1 : 0,
		'peer_supported is true on OpenBSD alone' );
};

subtest 'peer is undef where the platform is not supported' => sub {
	plan skip_all => 'the platform reports peer credentials'
	    if Fugu::Control->peer_supported;

	my ( $path, $pid ) = start_server(
		sub ($control) {
			$control->register(
				has_peer => sub ($) {
					return { seen => $control->peer
						    ? 1 : 0 };
				} );
		} );

	my $client = Fugu::Control::Client->new( path => $path );
	is_deeply( $client->request('has_peer'), { seen => 0 },
		'a handler sees undef off OpenBSD' );

	$client->disconnect;
	stop_server( $pid, $path );
};

subtest 'peer names the connected peer on OpenBSD' => sub {
	plan skip_all => 'peer credentials need OpenBSD'
	    unless Fugu::Control->peer_supported;

	my ( $path, $pid ) = start_server(
		sub ($control) {
			$control->register(
				whoami => sub ($) { $control->peer } );
		} );

	my $client = Fugu::Control::Client->new( path => $path );
	my $peer   = $client->request('whoami');

	ok( defined $peer, 'the handler read the credentials' )
	    or diag( $client->error // 'no error recorded' );
	is( $peer->{uid}, $>, 'the uid is the effective uid of the client' );
	is( $peer->{gid}, ( split ' ', $) )[0],
		'the gid is the effective gid of the client' );
	is( $peer->{pid}, $$, 'the pid is the pid of the client' );

	$client->disconnect;
	stop_server( $pid, $path );
};

t/fugu/mqtt.t  view on Meta::CPAN

# Test default values
{
    my $mqtt = Fugu::MQTT->new();
    
    is($mqtt->{host}, '127.0.0.1', 'Default host is localhost');
    is($mqtt->{port}, 1883, 'Default port is 1883');
    ok(!$mqtt->{connected}, 'Not connected by default');
}

# Test with credentials
{
    my $mqtt = Fugu::MQTT->new(
        host => 'broker.example.com',
        port => 8883,
        username => 'testuser',
        password => 'testpass',
    );
    
    is($mqtt->{username}, 'testuser', 'Username stored');
    is($mqtt->{password}, 'testpass', 'Password stored');