Net-MQTT-Simple-1.29/0000755000175000017500000000000014512231440013205 5ustar juerdjuerdNet-MQTT-Simple-1.29/Makefile.PL0000644000175000017500000000135414352717103015171 0ustar juerdjuerduse v5.10; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Net::MQTT::Simple', VERSION_FROM => 'lib/Net/MQTT/Simple.pm', ABSTRACT_FROM => 'lib/Net/MQTT/Simple.pm', EXE_FILES => [ 'bin/mqtt-simple' ], PREREQ_PM => { }, AUTHOR => 'Juerd Waalboer ', META_MERGE => { 'meta-spec' => { version => 2 }, resources => { repository => { type => 'git', url => 'https://github.com/Juerd/Net-MQTT-Simple.git', web => 'https://github.com/Juerd/Net-MQTT-Simple', }, bugtracker => { web => 'https://github.com/Juerd/Net-MQTT-Simple/issues' }, }, }, ); Net-MQTT-Simple-1.29/MANIFEST0000644000175000017500000000044014512231440014334 0ustar juerdjuerdlib/Net/MQTT/Simple.pm lib/Net/MQTT/Simple/SSL.pm bin/mqtt-simple t/use.t t/regex.t Makefile.PL README Changes MANIFEST META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Net-MQTT-Simple-1.29/Changes0000644000175000017500000001174714512225666014527 0ustar juerdjuerdRevision history for Perl extension Net::MQTT::Simple. Incompatible changes are marked with "!!". Incompatibility with and changes in "undocumented features" are not always specifically mentioned here. 1.29 2023-10-13 13:37 - Clarify license terms. 1.28 2022-12-28 02:37 - Fix: Don't hang when receiving signal during select() (Contributed by Peter Sobisch via RT 134165) - Doc fix: typo (Contributed by oalders via GitHub #15) - New: Repository metadata (Suggested by oalders via GitHub #14) - Some retroactive changes to the changelog: added some credits and issue IDs. !! - Dropped support for IO::Socket::INET. 1.27 2022-09-11 02:22 - Fix: Support messages larger than 16 kB on TLS (Contributed by CRCinAU via GitHub #20/#18) 1.26 2021-05-17 16:22 - Fix: Packet parsing (Reported by Balazs Szabo via email and by Peter Sobisch via RT 133188) 1.25 2021-02-04 19:30 - Fix: Remove callbacks on unsubscribe. (Contributed by marcbradshaw via GitHub #12) - Fix: Separate client ID per instance. (Contributed by hollie via GitHub #13) 1.24 2019-07-22 16:47 - Fix: Unsubscribe didn't work with newer mosquitto. - Fix: The procedural interface broke in 1.23 (use strict related). - Change: retroactively updated changelog; the apparent bug in Mosquitto was actually a bug fix, triggering a bug in Net::MQTT::Simple that was caused by misinterpretation of the MQTT 3.1.1 specifications. 1.23 2019-04-29 18:18 - New: env variables MQTT_SIMPLE_USERNAME and MQTT_SIMPLE_PASSWORD - New: undocumented global $Net::MQTT::Simple::PROTOCOL_LEVEL. (Contributed by mnoorenberghe via GitHub #5) - Fix: will no longer send invalid SUBSCRIBE message with a packet identifier of 0. (See change note in 1.24) !! - Now depends on a sane Perl installation with strict and warnings !! - Default protocol version is now 3.1.1 !! - Client identifier is now random instead of PID based 1.22 2018-12-01 21:01 - New: username/password authentication (login method) - Changelog now uses ISO dates - New: last_will and disconnect (Contributed by nicramage via Github #3) - Bug fix: connection was not restored until after the reconnect interval. 1.21 2015-09-12 01:32 - New: options --count, --message-only, --one in command line utility - Bug fix: enable autoflush in utility, for better pipe compatibility 1.20 2015-02-05 13:22 - Bug fix: /# also matched any topic that matches + (tests were wrong) (Reported by ral in #mqtt) - Bug fix: Subscription topics weren't UTF8-encoded - Improvement: tests for topics "" and "/" - New: -d/--datetime for mqtt-simple command line utility (Contributed by sigio via GitHub #2) - Code cleanups - New: Support for unsubscribing 1.16 2014-05-30 23:45 - Bug fix: Clear buffer on reconnect to avoid garbage. - New: Reconnect on ping timeout. 1.15 2014-05-27 22:35 - Bug fix: Client certificates now work. - Improvement: Pattern tests now includes those from mosquitto. (Suggested by karlp in #mqtt) 1.14 2014-05-27 13:09 !! - Bug fix: Unlike topics, message payloads are binary data, not text strings. This module no longer encodes or decodes them as UTF-8. A warning will be emitted if you try to publish data that is not binary compatbile. This change has no impact on 7 bit ASCII data. 1.13 2014-05-27 02:39 - New: SSL support - New: --except option for mqtt-simple command line utility - New: --raw option for mqtt-simple command line utility - New: --no-color option for mqtt-simple command line utility - Improvement: mqtt-simple enables color by default, for terminals - Improvement: mqtt-simple filters ASCII control codes - Improvement: filter_as_regex is exposed and documented 1.12 2014-05-26 16:24 - Bug fix: Update MANIFEST to include some new files (Reported by foobar in #revspace) - Bug fix: This file (Changes) mentioned the wrong distribution name (Reported by foobar in #revspace) - Improvement: Only try one reconnect per 5 seconds 1.11 2014-05-26 03:37 - Bug fix: Calculations for next ping were bad, resulting in ping flood - Bug fix: Avoid some Perl warnings under perl -w - Improvement: Emit warnings on stderr if connection failed - Improvement: Prevent possible infinite recursion 1.10 2014-05-26 02:11 - New: Support for MQTT subscriptions, with per-subscription handlers - New: Command line utility "mqtt-simple" - Improvement: Force reconnection after failed write to socket 1.01 2014-04-23 15:38 - Bug fix: $\ is now ignored (e.g. under perl -l) 1.00 2014-04-22 23:59 - Initial release Net-MQTT-Simple-1.29/t/0000755000175000017500000000000014512231440013450 5ustar juerdjuerdNet-MQTT-Simple-1.29/t/regex.t0000644000175000017500000001214412343430614014755 0ustar juerdjuerd#!/usr/bin/perl -w use strict; use Test::More; use Net::MQTT::Simple; *far = \&Net::MQTT::Simple::filter_as_regex; no warnings "qw"; # Boring spec tests, the "non normative comments" from the MQTT 3.1.1 draft SECTION_4_7_1_2: { my ($regex, $filter, $topic); $regex = far($filter = "sport/tennis/player1/#"); $topic = "sport/tennis/player1"; like($topic, qr/$regex/, "4.7.1.2, '$topic' should match '$filter'"); $topic = "sport/tennis/player1/ranking"; like($topic, qr/$regex/, "4.7.1.2, '$topic' should match '$filter'"); $topic = "sport/tennis/player1/wimbledon"; like($topic, qr/$regex/, "4.7.1.2, '$topic' should match '$filter'"); $regex = far($filter = "sport/#"); $topic = "sport"; like($topic, qr/$regex/, "4.7.1.2, '$topic' should match '$filter'"); } SECTION_4_7_1_3: { my ($regex, $filter, $topic); $regex = far($filter = "sport/tennis/+"); $topic = "sport/tennis/player1"; like($topic, qr/$regex/, "4.7.1.3, '$topic' should match '$filter'"); $topic = "sport/tennis/player2"; like($topic, qr/$regex/, "4.7.1.3, '$topic' should match '$filter'"); $topic = "sport/tennis/player1/ranking"; unlike($topic, qr/$regex/, "4.7.1.3, '$topic' should not match '$filter'"); $regex = far($filter = "sport/+"); $topic = "sport"; unlike($topic, qr/$regex/, "4.7.1.3, '$topic' should not match '$filter'"); $topic = "sport/"; like($topic, qr/$regex/, "4.7.1.3, '$topic' should match '$filter'"); } SECTION_4_7_2_1: { my ($regex, $filter, $topic); $regex = far($filter = "#"); $topic = "\$SYS/something"; unlike($topic, qr/$regex/, "4.7.2.1, '$topic' should not match '$filter'"); $regex = far($filter = "+/monitor/Clients"); $topic = "\$SYS/monitor/Clients"; unlike($topic, qr/$regex/, "4.7.2.1, '$topic' should not match '$filter'"); $regex = far($filter = "\$SYS/#"); $topic = "\$SYS/something"; like($topic, qr/$regex/, "4.7.2.1, '$topic' should match '$filter'"); $regex = far($filter = "\$SYS/monitor/+"); $topic = "\$SYS/monitor/Clients"; like($topic, qr/$regex/, "4.7.2.1, '$topic' should match '$filter'"); } # Now, let's try a more systematic approach my @matrix = ( # Topic Should match all of these, but none of the # other ones that are listed for other topics. [ "/", qw(# /# +/+ /) ], [ "foo", qw(# + foo/# foo) ], [ "foo/bar", qw(# +/+ foo/# foo/bar/# foo/+ +/bar foo/+/#) ], [ "foo//bar", qw(# +/+/+ foo/# foo//bar foo/+/bar foo/+/# foo//+) ], [ "/foo", qw(# /# +/+ /foo /foo/#) ], [ "/\$foo", qw(# /# +/+ /$foo /$foo/#) ], # Not special [ "/foo/bar", qw(# /# +/+/+ /foo/#)], [ "///", qw(# /# +/+/+/+) ], [ "foo/bar/baz", qw(# +/+/+ foo/# foo/bar/# foo/+/# +/bar/baz foo/+/baz foo/bar/+ +/+/baz) ], [ "\$foo", qw($foo $foo/#) ], # Special because it begins with $ [ "\$SYS/foo", qw($SYS/# $SYS/+ $SYS/foo) ], [ "\$SYS/foo/bar", qw($SYS/# $SYS/+/+ $SYS/foo/bar $SYS/+/bar $SYS/foo/+)], [ "fo2/bar/baz", qw(# fo2/bar/baz +/+/+ +/+/baz +/bar/baz) ], [ "foo///baz", qw(# foo/# foo/+/# foo/+/+/baz +/+/+/+) ], [ "foo/bar/", qw(# foo/# foo/+/# foo/bar/+ foo/bar/# +/+/+)], ); my %all_filters; for (@matrix) { $all_filters{ $_ }++ for @{ $_ }[ 1.. $#$_ ]; } for (@matrix) { my $topic = shift @$_; my @should_match = @$_; my %should_not_match = %all_filters; delete @should_not_match{ @should_match }; for my $filter (@should_match) { my $regex = far( $filter ); like($topic, qr/$regex/, "'$topic' should match '$filter'"); } for my $filter (sort keys %should_not_match) { my $regex = far( $filter ); unlike($topic, qr/$regex/, "'$topic' should not match '$filter'"); } } # These are from mosquitto's 03-pattern-matching.py my @mosquitto_tests = split "\n", <<'END'; pattern_test("#", "test/topic") pattern_test("#", "/test/topic") pattern_test("foo/#", "foo/bar/baz") pattern_test("foo/+/baz", "foo/bar/baz") pattern_test("foo/+/baz/#", "foo/bar/baz") pattern_test("foo/+/baz/#", "foo/bar/baz/bar") pattern_test("foo/foo/baz/#", "foo/foo/baz/bar") pattern_test("foo/#", "foo") pattern_test("/#", "/foo") pattern_test("test/topic/", "test/topic/") pattern_test("test/topic/+", "test/topic/") pattern_test("+/+/+/+/+/+/+/+/+/+/test", "one/two/three/four/five/six/seven/eight/nine/ten/test") pattern_test("#", "test////a//topic") pattern_test("#", "/test////a//topic") pattern_test("foo/#", "foo//bar///baz") pattern_test("foo/+/baz", "foo//baz") pattern_test("foo/+/baz//", "foo//baz//") pattern_test("foo/+/baz/#", "foo//baz") pattern_test("foo/+/baz/#", "foo//baz/bar") pattern_test("foo//baz/#", "foo//baz/bar") pattern_test("foo/foo/baz/#", "foo/foo/baz/bar") pattern_test("/#", "////foo///bar") END sub pattern_test { my ($pattern, $match) = @_; my $regex = far($pattern); like($match, qr/$regex/, "mosquitto: '$match' should match '$pattern'"); } eval for @mosquitto_tests; done_testing; Net-MQTT-Simple-1.29/t/use.t0000644000175000017500000000007012340760026014432 0ustar juerdjuerduse Test::More tests => 1; use_ok('Net::MQTT::Simple'); Net-MQTT-Simple-1.29/lib/0000755000175000017500000000000014512231440013753 5ustar juerdjuerdNet-MQTT-Simple-1.29/lib/Net/0000755000175000017500000000000014512231440014501 5ustar juerdjuerdNet-MQTT-Simple-1.29/lib/Net/MQTT/0000755000175000017500000000000014512231440015266 5ustar juerdjuerdNet-MQTT-Simple-1.29/lib/Net/MQTT/Simple/0000755000175000017500000000000014512231440016517 5ustar juerdjuerdNet-MQTT-Simple-1.29/lib/Net/MQTT/Simple/SSL.pm0000644000175000017500000000733713400546652017541 0ustar juerdjuerdpackage Net::MQTT::Simple::SSL; use base 'Net::MQTT::Simple'; use IO::Socket::SSL qw(SSL_VERIFY_NONE); my $sslver = IO::Socket::SSL->VERSION; # use strict; # might not be available (e.g. on openwrt) # use warnings; # same. BEGIN { *_croak = \&Net::MQTT::Simple::_croak } sub _socket_class { "IO::Socket::SSL" } sub _default_port { 8883 } sub _socket_error { shift->_socket_class->errstr } sub _secure { 1 } sub new { my ($class, $server, $sockopts) = @_; @_ == 2 or @_ == 3 or _croak "Wrong number of arguments for $class->new"; $sockopts ||= {}; if (my $ca = $ENV{MQTT_SIMPLE_SSL_CA}) { $sockopts->{-f $ca ? "SSL_ca_file" : "SSL_ca_path"} //= $ca; } if (my $cert = $ENV{MQTT_SIMPLE_SSL_CERT}) { $sockopts->{SSL_cert_file} //= $cert; } if (my $key = $ENV{MQTT_SIMPLE_SSL_KEY}) { $sockopts->{SSL_key_file} //= $key; } ## Fingerprint support in IO::Socket::SSL appears to be broken, even in ## 1.988: during validation, X509_digest returns a different hash than ## after connecting. Haven't investigated yet, so I don't know if this is ## a bug in their code or in mine. # if (my $fp = $ENV{MQTT_SIMPLE_SSL_FINGERPRINT}) { # $sockopts->{SSL_fingerprint} //= []; # if (not ref $sockopts->{SSL_fingerprint}) { # $sockopts->{SSL_fingerprint} = [ $sockopts->{SSL_fingerprint} ]; # } # push @{ $sockopts->{SSL_fingerprint} }, $fp; # } if (my $wtf = $ENV{MQTT_SIMPLE_SSL_INSECURE}) { warn "Warning: certificate validation disabled"; $sockopts->{SSL_verify_mode} = SSL_VERIFY_NONE; } return $class->SUPER::new($server, $sockopts); } 1; __END__ =head1 NAME Net::MQTT::Simple::SSL - Minimal MQTT version 3 interface with SSL support =head1 SYNOPSIS # Specifying SSL parameters in environment variables export MQTT_SIMPLE_SSL_CA=/etc/ssl/ca.crt export MQTT_SIMPLE_SSL_CERT=/etc/ssl/mqtt.crt export MQTT_SIMPLE_SSL_KEY=/etc/ssl/mqtt.key perl -MNet::MQTT::Simple::SSL=mosquitto.example.org \ -nle'retain "topic/here" => $_' # Specifying explicit SSL parameters use Net::MQTT::Simple::SSL; my $mqtt = Net::MQTT::Simple::SSL->new("mosquitto.example.org", { SSL_ca_file => '/etc/ssl/ca.crt', SSL_cert_file => '/etc/ssl/mqtt.crt', SSL_key_file => '/etc/ssl/mqtt.key', }); $mqtt->publish("topic/here" => "Message here"); $mqtt->retain( "topic/here" => "Message here"); =head1 DESCRIPTION A subclass of L that adds SSL/TLS. Like its base class, a server can be given on the C line, in which case C and C are exported so that they can be used as simple functions. This interface supports configuration via environment variables, but not via explicit options in code. The object oriented interface does support explicit SSL configuration. See L for a comprehensive overview of all the options that can be supplied to the constructor, C. =head2 Environment variables Instead of explicitly specifying the SSL options in the constructor, they can be set with environment variables. These are overridden by options given to C. =over 26 =item MQTT_SIMPLE_SSL_INSECURE Set to something other than C<0> to disable SSL validation. =item MQTT_SIMPLE_SSL_CA Path to the CA certificate or a directory of certificates. IO::Socket::SSL can find the CA path automatically on some systems. =item MQTT_SIMPLE_SSL_CERT =item MQTT_SIMPLE_SSL_KEY Path to the client certificate file and its key file. =back =head1 LICENSE Pick your favourite OSI approved license :) http://www.opensource.org/licenses/alphabetical =head1 AUTHOR Juerd Waalboer =head1 SEE ALSO L Net-MQTT-Simple-1.29/lib/Net/MQTT/Simple.pm0000644000175000017500000005303514512227330017066 0ustar juerdjuerdpackage Net::MQTT::Simple; use strict; use warnings; use IO::Socket::IP; our $VERSION = '1.29'; # Please note that these are not documented and are subject to change: our $KEEPALIVE_INTERVAL = 60; our $PING_TIMEOUT = 10; our $RECONNECT_INTERVAL = 5; our $MAX_LENGTH = 2097152; # 2 MB our $READ_BYTES = 16 * 1024; # 16 kB per IO::Socket::SSL recommendation our $WRITE_BYTES = 16 * 1024; # 16 kB per IO::Socket::SSL maximum our $PROTOCOL_LEVEL = 0x04; # 0x03 in v3.1, 0x04 in v3.1.1 our $PROTOCOL_NAME = "MQTT"; # MQIsdp in v3.1, MQTT in v3.1.1 my $global; sub _default_port { 1883 } sub _socket_class { 'IO::Socket::IP' } sub _socket_error { "$@" } sub _secure { 0 } sub _client_identifier { my ($class) = @_; return "Net::MQTT::Simple[" . $class->{random_id} . "]"; } # Carp might not be available either. sub _croak { die sprintf "%s at %s line %d.\n", "@_", (caller 1)[1, 2]; } sub filter_as_regex { my ($filter) = @_; return "^(?!\\\$)" if $filter eq '#'; # Match everything except /^\$/ return "^/" if $filter eq '/#'; # Parent (empty topic) is invalid $filter = quotemeta $filter; $filter =~ s{ \z (?new($server); no strict 'refs'; *{ (caller)[0] . "::publish" } = \&publish; *{ (caller)[0] . "::retain" } = \&retain; } sub new { my ($class, $server, $sockopts) = @_; @_ == 2 or @_ == 3 or _croak "Wrong number of arguments for $class->new"; my $port = $class->_default_port; # Add port for bare IPv6 address $server = "[$server]:$port" if $server =~ /:.*:/ and not $server =~ /\[/; # Add port for bare IPv4 address or bracketed IPv6 address $server .= ":$port" if $server !~ /:/ or $server =~ /^\[.*\]$/; # Create a random ID for the instance of the object my $random_id = join "", map chr 65 + int rand 26, 1 .. 10; return bless { server => $server, last_connect => 0, sockopts => $sockopts // {}, random_id => $random_id }, $class; } sub last_will { my ($self, $topic, $message, $retain) = @_; my %old; %old = %{ $self->{will} } if $self->{will}; _croak "Wrong number of arguments for last_will" if @_ > 4; if (@_ >= 2) { if (not defined $topic and not defined $message) { delete $self->{will}; delete $self->{encoded_will}; return; } else { $self->{will} = { topic => $topic // $old{topic} // '', message => $message // $old{message} // '', retain => !!$retain // $old{retain} // 0, }; _croak("Topic is empty") if not length $self->{will}->{topic}; my $e = $self->{encoded_will} = { %{ $self->{will} } }; utf8::encode($e->{topic}); utf8::downgrade($e->{message}, 1) or do { my ($file, $line, $method) = (caller 1)[1, 2, 3]; warn "Wide character in $method at $file line $line.\n"; utf8::encode($e->{message}); }; } } return @{ $self->{will} }{qw/topic message retain/}; } sub login { my ($self, $username, $password) = @_; if (@_ > 1) { _croak "Password login is disabled for insecure connections" if defined $password and not $self->_secure || $ENV{MQTT_SIMPLE_ALLOW_INSECURE_LOGIN}; utf8::encode($username); $self->{username} = $username; $self->{password} = $password; } return $username; } sub _connect { my ($self) = @_; return if $self->{socket} and $self->{socket}->connected; if ($self->{last_connect} > time() - $RECONNECT_INTERVAL) { select undef, undef, undef, .01; return; } # Reset state $self->{last_connect} = time; $self->{buffer} = ""; delete $self->{ping}; # Connect my $socket_class = $self->_socket_class; my %socket_options = ( PeerAddr => $self->{server}, %{ $self->{sockopts} } ); $self->{socket} = $socket_class->new( %socket_options ) or warn "$0: connect: " . $self->_socket_error . "\n"; # Say hello local $self->{skip_connect} = 1; # avoid infinite recursion :-) $self->_send_connect; $self->_send_subscribe; } sub _prepend_variable_length { # Copied from Net::MQTT::Constants my ($data) = @_; my $v = length $data; my $o = ""; my $d; do { $d = $v % 128; $v = int($v/128); $d |= 0x80 if $v; $o .= pack "C", $d; } while $d & 0x80; return "$o$data"; } sub _send { my ($self, $data) = @_; $self->_connect unless exists $self->{skip_connect}; delete $self->{skip_connect}; my $socket = $self->{socket} or return; while (my $chunk = substr $data, 0, $WRITE_BYTES, "") { syswrite $socket, $chunk or $self->_drop_connection; # reconnect on next message } $self->{last_send} = time; } sub _send_connect { my ($self) = @_; my $will = $self->{encoded_will}; my $flags = 0x02; $flags |= 0x04 if $will; $flags |= 0x20 if $will and $will->{retain}; $flags |= 0x80 if defined $self->{username}; $flags |= 0x40 if defined $self->{username} and defined $self->{password}; $self->_send("\x10" . _prepend_variable_length(pack( "x C/a* C C n n/a*" . ($flags & 0x04 ? "n/a* n/a*" : "") . ($flags & 0x80 ? "n/a*" : "") . ($flags & 0x40 ? "n/a*" : ""), $PROTOCOL_NAME, $PROTOCOL_LEVEL, $flags, $KEEPALIVE_INTERVAL, $self->_client_identifier, ($flags & 0x04 ? ($will->{topic}, $will->{message}) : ()), ($flags & 0x80 ? $self->{username} : ()), ($flags & 0x40 ? $self->{password} : ()), ))); } sub _send_subscribe { my ($self, @topics) = @_; if (not @topics) { @topics = keys %{ $self->{sub} } or return; } return if not @topics; utf8::encode($_) for @topics; # Hardcoded "packet identifier" \0\x01 for now (was \0\0 but the spec # disallows it for subscribe packets and mosquitto started enforcing that.) $self->_send("\x82" . _prepend_variable_length("\0\x01" . pack("(n/a* x)*", @topics) # x = QoS 0 )); } sub _send_unsubscribe { my ($self, @topics) = @_; return if not @topics; utf8::encode($_) for @topics; # Hardcoded "packet identifier" \0\0x01 for now; see above. $self->_send("\xa2" . _prepend_variable_length("\0\x01" . pack("(n/a*)*", @topics) )); } sub _parse { my ($self) = @_; my $bufref = \$self->{buffer}; return if length $$bufref < 2; my $offset = 1; my $length = do { my $multiplier = 1; my $v = 0; my $d; do { return if $offset >= length $$bufref; # not enough data yet $d = unpack "C", substr $$bufref, $offset++, 1; $v += ($d & 0x7f) * $multiplier; $multiplier *= 128; } while ($d & 0x80); $v; }; if ($length > $MAX_LENGTH) { # On receiving an enormous packet, just disconnect to avoid exhausting # RAM on tiny systems. # TODO: just slurp and drop the data $self->_drop_connection; return; } return if length($$bufref) < $offset + $length; # not enough data yet my $first_byte = unpack "C", substr $$bufref, 0, 1; my $packet = { type => ($first_byte & 0xF0) >> 4, dup => ($first_byte & 0x08) >> 3, qos => ($first_byte & 0x06) >> 1, retain => ($first_byte & 0x01), data => substr($$bufref, $offset, $length), }; substr $$bufref, 0, $offset + $length, ""; # remove the parsed bits. return $packet; } sub _incoming_publish { my ($self, $packet) = @_; # Because QoS is not supported, no packed ID in the data. It would # have been 16 bits between $topic and $message. my ($topic, $message) = unpack "n/a a*", $packet->{data}; utf8::decode($topic); for my $cb (@{ $self->{callbacks} }) { if ($topic =~ /$cb->{regex}/) { $cb->{callback}->($topic, $message, $packet->{retain}); return; } } } sub _publish { my ($self, $retain, $topic, $message) = @_; $message //= "" if $retain; utf8::encode($topic); utf8::downgrade($message, 1) or do { my ($file, $line, $method) = (caller 1)[1, 2, 3]; warn "Wide character in $method at $file line $line.\n"; utf8::encode($message); }; $self->_send( ($retain ? "\x31" : "\x30") . _prepend_variable_length( pack("n/a*", $topic) . $message ) ); } sub publish { my $method = UNIVERSAL::isa($_[0], __PACKAGE__); @_ == ($method ? 3 : 2) or _croak "Wrong number of arguments for publish"; ($method ? shift : $global)->_publish(0, @_); } sub retain { my $method = UNIVERSAL::isa($_[0], __PACKAGE__); @_ == ($method ? 3 : 2) or _croak "Wrong number of arguments for retain"; ($method ? shift : $global)->_publish(1, @_); } sub run { my ($self, @subscribe_args) = @_; $self->subscribe(@subscribe_args) if @subscribe_args; until ($self->{stop_loop}) { my @timeouts; push @timeouts, $KEEPALIVE_INTERVAL - (time() - $self->{last_send}) if exists $self->{last_send}; push @timeouts, $PING_TIMEOUT - (time() - $self->{ping}) if exists $self->{ping}; my $timeout = @timeouts ? (sort { $a <=> $b } @timeouts)[0] : 1; # default to 1 $self->tick($timeout); } delete $self->{stop_loop}; } sub subscribe { my ($self, @kv) = @_; while (my ($topic, $callback) = splice @kv, 0, 2) { $self->{sub}->{ $topic } = 1; push @{ $self->{callbacks} }, { topic => $topic, regex => filter_as_regex($topic), callback => $callback, }; } $self->_send_subscribe() if $self->{socket}; } sub unsubscribe { my ($self, @topics) = @_; $self->_send_unsubscribe(@topics); my $cb = $self->{callbacks}; for my $topic ( @topics ) { @$cb = grep {$_->{topic} ne $topic} @$cb; } delete @{ $self->{sub} }{ @topics }; } sub tick { my ($self, $timeout) = @_; $self->_connect; my $socket = $self->{socket} or return; my $bufref = \$self->{buffer}; my $r = ''; vec($r, fileno($socket), 1) = 1; if (select($r, undef, undef, $timeout // 0) > 0) { sysread $socket, $$bufref, $READ_BYTES, length $$bufref or delete $self->{socket}; while (length $$bufref) { my $packet = $self->_parse() or last; $self->_incoming_publish($packet) if $packet->{type} == 3; delete $self->{ping} if $packet->{type} == 13; } } if (time() >= $self->{last_send} + $KEEPALIVE_INTERVAL) { $self->_send("\xc0\0"); # PINGREQ $self->{ping} = time; } if ($self->{ping} and time() >= $self->{ping} + $PING_TIMEOUT) { $self->_drop_connection; } return !! $self->{socket}; } sub disconnect { my ($self) = @_; $self->_send(pack "C x", 0xe0) if $self->{socket} and $self->{socket}->connected; $self->_drop_connection; } sub _drop_connection { my ($self) = @_; delete $self->{socket}; $self->{last_connect} = 0; } 1; __END__ =head1 NAME Net::MQTT::Simple - Minimal MQTT version 3 interface =head1 SYNOPSIS # One-liner that publishes sensor values from STDIN perl -MNet::MQTT::Simple=mosquitto.example.org \ -nle'retain "topic/here" => $_' # Functional (single server only) use Net::MQTT::Simple "mosquitto.example.org"; publish "topic/here" => "Message here"; retain "topic/here" => "Retained message here"; # Object oriented (supports subscribing to topics) use Net::MQTT::Simple; my $mqtt = Net::MQTT::Simple->new("mosquitto.example.org"); $mqtt->publish("topic/here" => "Message here"); $mqtt->retain( "topic/here" => "Message here"); $mqtt->run( "sensors/+/temperature" => sub { my ($topic, $message) = @_; die "The building's on fire" if $message > 150; }, "#" => sub { my ($topic, $message) = @_; print "[$topic] $message\n"; }, ); =head1 DESCRIPTION This module consists of only one file and has no dependencies except core Perl modules, making it suitable for embedded installations where CPAN installers are unavailable and resources are limited. Only basic MQTT functionality is provided; if you need more, you'll have to use the full-featured L instead. Connections are set up on demand, automatically reconnecting to the server if a previous connection had been lost. Because sensor scripts often run unattended, connection failures will result in warnings (on STDERR if you didn't override that) without throwing an exception. Please refer to L for more information about encrypted and authenticated connections. =head2 Functional interface This will suffice for most simple sensor scripts. A socket is kept open for reuse until the script has finished. The functional interface cannot be used for subscriptions, only for publishing. Instead of requesting symbols to be imported, provide the MQTT server on the C line. A non-standard port can be specified with a colon. The functions C and C will be exported. =head2 Object oriented interface =head3 new(server[, sockopts]) Specify the server (possibly with a colon and port number) to the constructor, C<< Net::MQTT::Simple->new >>. The socket is disconnected when the object goes out of scope. Optionally, a reference to a hash of socket options can be passed. Options specified in this hash are passed on to the socket constructor. =head3 last_will([$topic, $message[, $retain]]) Set a "Last Will and Testament", to be used on subsequent connections. Note that the last will cannot be updated for a connection that is already established. A last will is a message that is published by the broker on behalf of the client, if the connection is dropped without an explicit call to C. Without arguments, returns the current values without changing the active configuration. When the given topic and message are both undef, the last will is deconfigured. In other cases, only arguments which are C are updated with the given value. For the first setting, the topic is mandatory, the message defaults to an empty string, and the retain flag defaults to false. Returns a list of the three values in the same order as the arguments. =head3 login($username[, $password]) Sets authentication credentials, to be used on subsequent connections. Note that the credentials cannot be updated for a connection that is already established. The username is text, the password is binary. See L for information about secure connections. To enable insecure password authenticated connections, set the environment variable MQTT_SIMPLE_ALLOW_INSECURE_LOGIN to a true value. Returns the username. =head1 DISCONNECTING GRACEFULLY =head2 disconnect Performs a graceful disconnect, which ensures that the server does NOT send the registered "Last Will" message. Subsequent calls that require a connection, will cause a new connection to be set up. =head1 PUBLISHING MESSAGES The two methods for publishing messages are the same, except for the state of the C flag. =head2 retain(topic, message) Publish the message with the C flag on. Use this for sensor values or anything else where the message indicates the current status of something. To discard a retained topic, provide an empty or undefined message. =head2 publish(topic, message) Publishes the message with the C flag off. Use this for ephemeral messages about events that occur (like that a button was pressed). =head1 SUBSCRIPTIONS =head2 subscribe(topic, handler[, topic, handler, ...]) Subscribes to the given topic(s) and registers the callbacks. Note that only the first matching handler will be called for every message, even if filter patterns overlap. =head2 unsubscribe(topic[, topic, ...]) Unsubscribes from the given topic(s) and unregisters the corresponding callbacks. The given topics must exactly match topics that were previously used with the C method. =head2 run(...) Enters an infinite loop, which calls C repeatedly. If any arguments are given, they will be passed to C first. =head2 tick(timeout) Test the socket to see if there's any incoming message, waiting at most I seconds (can be fractional). Use a timeout of C<0> to avoid blocking, but note that blocking automatic reconnection may take place, which may take much longer. If C returns false, this means that the socket was no longer connected and that the next call will cause a reconnection attempt. However, a true value does not necessarily mean that the socket is still functional. The only way to reliably determine that a TCP stream is still connected, is to actually communicate with the server, e.g. with a ping, which is only done periodically. =head1 UTILITY FUNCTIONS =head2 Net::MQTT::Simple::filter_as_regex(topic_filter) Given a valid MQTT topic filter, returns the corresponding regular expression. =head1 IPv6 PREREQUISITE For IPv6 support, the module L needs to be installed. It comes with Perl 5.20 and is available from CPAN for older Perls. If this module is not available, the older L will be used, which only supports Legacy IP (IPv4). =head1 MANUAL INSTALLATION If you can't use the CPAN installer, you can actually install this module by creating a directory C and putting C in it. Please note that this method does not work for every Perl module and should be used only as a last resort on systems where proper installers are not available. To view the list of C<@INC> paths where Perl searches for modules, run C. This list includes the current working directory (C<.>). Additional include paths can be specified in the C environment variable; see L. =head1 NOT SUPPORTED =over 4 =item QoS (Quality of Service) Every message is published at QoS level 0, that is, "at most once", also known as "fire and forget". =item DUP (Duplicate message) Since QoS is not supported, no retransmissions are done, and no message will indicate that it has already been sent before. =item Authentication No username and password are sent to the server. =item Large data Because everything is handled in memory and there's no way to indicate to the server that large messages are not desired, the connection is dropped as soon as the server announces a packet larger than 2 megabytes. =item Validation of server-to-client communication The MQTT spec prescribes mandatory validation of all incoming data, and disconnecting if anything (really, anything) is wrong with it. However, this minimal implementation silently ignores anything it doesn't specifically handle, which may result in weird behaviour if the server sends out bad data. Most clients do not adhere to this part of the specifications. =back =head1 CAVEATS =head2 Automatic reconnection Connection and reconnection are handled automatically, but without retries. If anything goes wrong, this will cause a single reconnection attempt before the following action. For example, if sending a message fails because of a disconnected socket, the message will not be resent, but the next message might succeed. Only one new connection attempt is done per approximately 5 seconds. This behaviour is intended. =head2 Unicode This module uses the proper Perl Unicode abstractions for parts that according to the MQTT specification are UTF-8 encoded. This includes Is, but not Is. Published messages are binary data, which you may have to encode and decode yourself. This means that if you have UTF-8 encoded string literals in your code, you should C and that any of those strings which is a I will need to be encoded by you, for example with C. It also means that a I should never contain any character with an ordinal value of greater than 255, because those cannot be used in binary communication. If you're passing non-ASCII text strings, encode them before publishing, decode them after receiving. A character greater than 255 results in a warning Wide character in publish at yourfile.pl line 42. while the UTF-8 encoded data is passed through. To get rid of the warning, use C. =head1 LICENSE This software may be redistributed under the terms of the GPL, LGPL, modified BSD, or Artistic license, or any of the other OSI approved licenses listed at http://www.opensource.org/licenses/alphabetical. Distribution is allowed under all of these these licenses, or any smaller subset of multiple or just one of these licenses. When using a packaged version, please refer to the package metadata to see under which license terms it was distributed. Alternatively, a distributor may choose to replace the LICENSE section of the documentation and/or include a LICENSE file to reflect the license(s) they chose to redistribute under. =head1 AUTHOR Juerd Waalboer =head1 SEE ALSO L, L Net-MQTT-Simple-1.29/META.yml0000644000175000017500000000125214512231440014456 0ustar juerdjuerd--- abstract: 'Minimal MQTT version 3 interface' author: - 'Juerd Waalboer ' build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.64, CPAN::Meta::Converter version 2.150010' license: unknown meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Net-MQTT-Simple no_index: directory: - t - inc requires: {} resources: bugtracker: https://github.com/Juerd/Net-MQTT-Simple/issues repository: https://github.com/Juerd/Net-MQTT-Simple.git version: '1.29' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Net-MQTT-Simple-1.29/META.json0000644000175000017500000000226114512231440014627 0ustar juerdjuerd{ "abstract" : "Minimal MQTT version 3 interface", "author" : [ "Juerd Waalboer " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.64, CPAN::Meta::Converter version 2.150010", "license" : [ "unknown" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Net-MQTT-Simple", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : {} } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/Juerd/Net-MQTT-Simple/issues" }, "repository" : { "type" : "git", "url" : "https://github.com/Juerd/Net-MQTT-Simple.git", "web" : "https://github.com/Juerd/Net-MQTT-Simple" } }, "version" : "1.29", "x_serialization_backend" : "JSON::PP version 4.07" } Net-MQTT-Simple-1.29/bin/0000755000175000017500000000000014512231440013755 5ustar juerdjuerdNet-MQTT-Simple-1.29/bin/mqtt-simple0000755000175000017500000001553514352717103016177 0ustar juerdjuerd#!/usr/bin/perl -w use strict; use Net::MQTT::Simple; use Getopt::Long qw(GetOptions); $| = 1; my $usage = "Usage: man mqtt-simple ;-)\n"; my @colors = qw(33;1 32;1 31;1 35;1 36;1 37;1 33 32 31 35 36); GetOptions( "h|host=s" => \my $host, "c|color!" => \(my $color = -t STDOUT), "raw" => \my $raw, "1|one" => \my $one, "count=i" => \my $count, "message-only" => \my $message_only, "s|t|subscribe=s" => \my @topics, "p|publish=s" => \my $publish, "r|retain" => \my $retain, "m|message=s" => \my $message, "d|datetime:s" => \my $datetime, "ssl" => \my $ssl, "insecure" => \my $insecure, "ca=s" => \my $ca, "cert=s" => \my $cert, "key=s" => \my $key, "e|except=s" => \my @exceptions, "u|user|username=s" => \my $username, "pass|password=s" => \my $password, ) or die $usage; $host or die $usage; $datetime = "%Y-%m-%d %H:%M:%S" if defined $datetime and $datetime eq ""; die "--ca, --cert, --key and --insecure require --ssl\n" if ($ca or $cert or $key) and not $ssl; die "--key requires --cert\n" if $key and not $cert; die "--cert requires --key\n" if $cert and not $key; require Net::MQTT::Simple::SSL if $ssl; my $class = $ssl ? "Net::MQTT::Simple::SSL" : "Net::MQTT::Simple"; $ENV{MQTT_SIMPLE_SSL_CA} = $ca if $ca; $ENV{MQTT_SIMPLE_SSL_CERT} = $cert if $cert; $ENV{MQTT_SIMPLE_SSL_KEY} = $key if $key; $ENV{MQTT_SIMPLE_SSL_INSECURE} = 1 if $insecure; $ENV{MQTT_SIMPLE_ALLOW_INSECURE_LOGIN} = 1 if $insecure; if ($one) { die "--count and --one cannot be combined" if $count; $count = 1; $message_only = 1; } defined $publish or @topics or die $usage; my $m = $class->new($host); $username = $ENV{MQTT_SIMPLE_USERNAME} if not defined $username; $password = $ENV{MQTT_SIMPLE_PASSWORD} if not defined $password; $m->login($username, $password) if defined $username; if (defined $publish) { my $method = $retain ? "retain" : "publish"; if (defined $message) { $m->$method($publish, $message); } else { while (defined (my $line = readline *STDIN)) { chomp $line; $m->$method($publish, $line); } } } elsif (defined $message) { die "-m requires -p. $usage"; } elsif ($retain) { die "-r requires -p. $usage"; } $_ = Net::MQTT::Simple::filter_as_regex($_) for @exceptions; if (@topics) { my $i = 0; my $ansi_reset = $color ? "\e[0m" : ""; my $iv = $color ? "\e[7m" : "^"; # inverse video or caret my $pv = $color ? "\e[27m" : ""; for (@topics) { my $ansi = $color ? "\e[$colors[ $i % @colors ]m" : ""; $i++; $m->subscribe( $_ => sub { my ($topic, $message) = @_; $topic =~ /$_/ and return for @exceptions; utf8::encode($topic); # $message is binary data so our output can have mixed encodings unless ($raw) { s/([\0-\x1F])/$iv . chr(64 + ord $1) . $pv/ge for $topic, $message; } print POSIX::strftime($datetime . " ", localtime) if defined $datetime; print "$ansi$topic$ansi_reset " unless $message_only; print "$message\n"; exit if defined $count and --$count == 0; }); } $m->run; } __END__ =head1 NAME mqtt-simple - Very simple MQTT implementation =head1 SYNOPSIS mqtt-simple -h mqtt.example.org -c -s "sensors/#" -s "debug/#" -s "#" mqtt-simple -h mqtt.example.org -p "example/unretained" -m "message" mqtt-simple -h mqtt.example.org -r -p "example/retained" -m "message" tail -f logfile | mqtt-simple -h mqtt.example.org -p "log/example" mqtt-simple --ssl --insecure ... mqtt-simple --ssl --ca ca.crt --cert client.crt --key client.key =head1 DESCRIPTION This is just a simple utility program. It doesn't do much. Specifically, all the QoS features are unsupported. Also, don't expect fancy error messages and such :-) =head1 COMMAND LINE OPTIONS =over 25 =item -h --host MQTT server to connect to, required. =item -p --publish I Publish a message. Uses the message given with C<-m>, or will read lines from B, and publish a message for each given line. =item -m --message I Message to publish. Requires C<-p>. =item -r --retain Causes messages published with C<-p> to have the "retain" flag on. =item -s --subscribe I Subscribe to the given topic filter. Use the standard MQTT wildcards like C<+> and C<#>. Outputs matching published messages on B. Can be given multiple times. =item -e --except I Suppress published messages that match I. Can be given multiple times. =item --count I Quit after receiving I messages. =item --message-only Output only the message values, without the topics. =item -1 --one Shortcut for C<--count 1 --message-only>. =item --color =item --no-color For each given C<-s>, print the matching topic in a different color. Note that the first matching topic will be used for color selection, so specify the topics with the most specific one first, the least specific one (like C<#>) last. Color is enabled by default if I is a terminal. =item --raw Pass ASCII control characters unaltered. By default, they're replaced by C<^@> notation or, when C<--color> is enabled, reverse video characters. For example, an ASCII newline would be displayed as C<^J> unless C<--raw> is used. =item -d --datetime I Prefix messages with a timestamp. Optionally, a I for C can be supplied. =item -u --user --username I Specify a username. Overrides the environment variable C. =item --pass --password I Specify a password. Overrides the environment variable C. =back =head2 SSL options =over 25 =item --ssl Use SSL instead of unencrypted connection. =item --insecure Disable SSL certificate validation and enable clear text passwords. Useful for testing, bad idea in production. Overrides the environment variables C and C. =item --ca I The Certificate Authority to validate against. I can be a file or a directory. If unspecified, IO::Socket::SSL attempts to use the system wide CA configuration. Overrides the environment variable C. =item --cert I =item --key I A client certificate with its key. Override the environment variables C and C. =back =head1 LICENSE Pick your favourite OSI approved license :) http://www.opensource.org/licenses/alphabetical =head1 AUTHOR Juerd Waalboer =head1 SEE ALSO L Net-MQTT-Simple-1.29/README0000644000175000017500000000200714307632634014100 0ustar juerdjuerdNAME Net::MQTT::Simple - Minimal MQTT version 3 interface DOCUMENTATION https://metacpan.org/pod/mqtt-simple https://metacpan.org/pod/Net::MQTT::Simple https://metacpan.org/pod/Net::MQTT::Simple::SSL INSTALLATION To install this module type the following: perl Makefile.PL make make test make install or use "cpan Net::MQTT::Simple" on the command line to automate the process. MANUAL INSTALLATION If you can't use the CPAN installer, you can actually install this module by creating a directory "Net/MQTT" and putting "Simple.pm" in it. Please note that this method does not work for every Perl module and should be used only as a last resort on systems where proper installers are not available. To view the list of @INC paths where Perl searches for modules, run "perl -V". This list includes the current working directory ("."). Additional include paths can be specified in the "PERL5LIB" environment variable; see perlenv.