mirror of
https://github.com/fhem/fhem-mirror.git
synced 2025-01-31 06:39:11 +00:00
00_MQTT2_SERVER.pm/10_MQTT2_DEVICE.pm: first version
git-svn-id: https://svn.fhem.de/fhem/trunk@17116 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
rudolfkoenig
parent
437281fc21
commit
ad04322fdf
@ -1,5 +1,6 @@
|
||||
# Add changes at the top of the list. Keep it in ASCII, and 80-char wide.
|
||||
# Do not insert empty lines here, update check depends on it.
|
||||
- new: 00_MQTT2_SERVER / 10_MQTT2_DEVICE
|
||||
- bugfix: 93_DbRep: fix in fetchrow function (forum:#89886),fix highlighting
|
||||
- bugfix: 82_LGTV_WebOS: fix set cmd for AmazonLovefilm
|
||||
- feature: 51_MOBILEALERTS: added feature to adjust values in define
|
||||
|
||||
496
fhem/FHEM/00_MQTT2_SERVER.pm
Normal file
496
fhem/FHEM/00_MQTT2_SERVER.pm
Normal file
@ -0,0 +1,496 @@
|
||||
##############################################
|
||||
# $Id$
|
||||
package main;
|
||||
|
||||
# TODO: save retain, Test SSL
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use TcpServerUtils;
|
||||
use MIME::Base64;
|
||||
|
||||
sub MQTT2_SERVER_Parse($$$);
|
||||
sub MQTT2_SERVER_Read($@);
|
||||
sub MQTT2_SERVER_Write($$$);
|
||||
sub MQTT2_SERVER_Undef($@);
|
||||
sub MQTT2_SERVER_doPublish($$$;$$);
|
||||
|
||||
|
||||
# See also:
|
||||
# http://docs.oasis-open.org/mqtt/mqtt/v3.1.1/os/mqtt-v3.1.1-os.html
|
||||
|
||||
sub
|
||||
MQTT2_SERVER_Initialize($)
|
||||
{
|
||||
my ($hash) = @_;
|
||||
|
||||
$hash->{Clients} = ":MQTT2_DEVICE:";
|
||||
$hash->{ReadFn} = "MQTT2_SERVER_Read";
|
||||
$hash->{DefFn} = "MQTT2_SERVER_Define";
|
||||
$hash->{AttrFn} = "MQTT2_SERVER_Attr";
|
||||
$hash->{SetFn} = "MQTT2_SERVER_Set";
|
||||
$hash->{UndefFn} = "MQTT2_SERVER_Undef";
|
||||
$hash->{WriteFn} = "MQTT2_SERVER_Write";
|
||||
$hash->{CanAuthenticate} = 1;
|
||||
|
||||
no warnings 'qw';
|
||||
my @attrList = qw(
|
||||
disable:0,1
|
||||
disabledForIntervals
|
||||
rawEvents:0,1
|
||||
SSL:0,1
|
||||
);
|
||||
use warnings 'qw';
|
||||
$hash->{AttrList} = join(" ", @attrList);
|
||||
}
|
||||
|
||||
#####################################
|
||||
sub
|
||||
MQTT2_SERVER_Define($$)
|
||||
{
|
||||
my ($hash, $def) = @_;
|
||||
my ($name, $type, $port, $global) = split("[ \t]+", $def);
|
||||
return "Usage: define <name> MQTT2_SERVER [IPV6:]<tcp-portnr> [global]"
|
||||
if($port !~ m/^(IPV6:)?\d+$/);
|
||||
|
||||
MQTT2_SERVER_Undef($hash, undef) if($hash->{OLDDEF}); # modify
|
||||
my $ret = TcpServer_Open($hash, $port, $global);
|
||||
|
||||
# Make sure that fhem only runs once
|
||||
if($ret && !$init_done) {
|
||||
Log3 $hash, 1, "$ret. Exiting.";
|
||||
exit(1);
|
||||
}
|
||||
$hash->{clients} = {};
|
||||
$hash->{retain} = {};
|
||||
InternalTimer(1, "MQTT2_SERVER_keepaliveChecker", $hash, 0);
|
||||
return $ret;
|
||||
}
|
||||
|
||||
sub
|
||||
MQTT2_SERVER_keepaliveChecker($)
|
||||
{
|
||||
my ($hash) = @_;
|
||||
my $now = gettimeofday();
|
||||
foreach my $clName (keys $hash->{clients}) {
|
||||
my $cHash = $defs{$clName};
|
||||
next if(!$cHash || !$cHash->{keepalive} ||
|
||||
$now < $cHash->{lastMsgTime}+$cHash->{keepalive}*1.5 );
|
||||
Log3 $hash, 3, "$hash->{NAME}: $clName left us (keepalive check)";
|
||||
CommandDelete(undef, $clName);
|
||||
}
|
||||
InternalTimer($now+10, "MQTT2_SERVER_keepaliveChecker", $hash, 0);
|
||||
}
|
||||
|
||||
sub
|
||||
MQTT2_SERVER_Undef($@)
|
||||
{
|
||||
my ($hash, $arg) = @_;
|
||||
my $ret = TcpServer_Close($hash);
|
||||
my $sname = $hash->{SNAME};
|
||||
return undef if(!$sname);
|
||||
delete($defs{$sname}{clients}{$hash->{NAME}});
|
||||
|
||||
if($hash->{lwt}) { # Last will
|
||||
my ($tp, $val) = split(':', $hash->{lwt}, 2);
|
||||
MQTT2_SERVER_doPublish($defs{$sname}, $tp, $val, undef,
|
||||
$hash->{cflags} & 0x20);
|
||||
}
|
||||
return $ret;
|
||||
}
|
||||
|
||||
sub
|
||||
MQTT2_SERVER_Attr(@)
|
||||
{
|
||||
my ($type, $devName, $attrName, @param) = @_;
|
||||
my $hash = $defs{$devName};
|
||||
if($type eq "set" && $attrName eq "SSL") {
|
||||
TcpServer_SetSSL($hash);
|
||||
}
|
||||
return undef;
|
||||
}
|
||||
|
||||
sub
|
||||
MQTT2_SERVER_Set($@)
|
||||
{
|
||||
my ($hash, @a) = @_;
|
||||
my %sets = ( publish=>1 );
|
||||
shift(@a);
|
||||
|
||||
return "Unknown argument ?, choose one of ".join(" ", keys %sets)
|
||||
if(!$a[0] || !$sets{$a[0]});
|
||||
|
||||
if($a[0] eq "publish") {
|
||||
shift(@a);
|
||||
my $retain;
|
||||
if(@a>2 && $a[0] eq "-r") {
|
||||
$retain = 1;
|
||||
shift(@a);
|
||||
}
|
||||
return "Usage: publish -r topic [value]" if(@a < 1);
|
||||
my $tp = shift(@a);
|
||||
my $val = join(" ", @a);
|
||||
MQTT2_SERVER_doPublish($hash, $tp, $val, undef, $retain);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
my %cptype = (
|
||||
0 => "RESERVED_0",
|
||||
1 => "CONNECT",
|
||||
2 => "CONNACK",
|
||||
3 => "PUBLISH",
|
||||
4 => "PUBACK",
|
||||
5 => "PUBREC",
|
||||
6 => "PUBREL",
|
||||
7 => "PUBCOMP",
|
||||
8 => "SUBSCRIBE",
|
||||
9 => "SUBACK",
|
||||
10 => "UNSUBSCRIBE",
|
||||
11 => "UNSUBACK",
|
||||
12 => "PINGREQ",
|
||||
13 => "PINGRESP",
|
||||
14 => "DISCONNECT",
|
||||
15 => "RESERVED_15",
|
||||
);
|
||||
|
||||
#####################################
|
||||
sub
|
||||
MQTT2_SERVER_Read($@)
|
||||
{
|
||||
my ($hash, $reread) = @_;
|
||||
|
||||
if($hash->{SERVERSOCKET}) { # Accept and create a child
|
||||
my $nhash = TcpServer_Accept($hash, "MQTT2_SERVER");
|
||||
return if(!$nhash);
|
||||
$nhash->{CD}->blocking(0);
|
||||
return;
|
||||
}
|
||||
|
||||
my $sname = $hash->{SNAME};
|
||||
my $cname = $hash->{NAME};
|
||||
my $c = $hash->{CD};
|
||||
|
||||
if(!$reread) {
|
||||
my $buf;
|
||||
my $ret = sysread($c, $buf, 1024);
|
||||
|
||||
if(!defined($ret) && $! == EWOULDBLOCK ){
|
||||
$hash->{wantWrite} = 1
|
||||
if(TcpServer_WantWrite($hash));
|
||||
return;
|
||||
|
||||
} elsif(!$ret) {
|
||||
CommandDelete(undef, $cname);
|
||||
Log3 $sname, 4, "Connection closed for $cname: ".
|
||||
(defined($ret) ? 'EOF' : $!);
|
||||
return;
|
||||
}
|
||||
|
||||
$hash->{BUF} .= $buf;
|
||||
if($hash->{SSL} && $c->can('pending')) {
|
||||
while($c->pending()) {
|
||||
sysread($c, $buf, 1024);
|
||||
$hash->{BUF} .= $buf;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
my ($tlen, $off) = MQTT2_SERVER_getRemainingLength($hash);
|
||||
if($tlen < 0) {
|
||||
Log3 $sname, 1, "Bogus data from $cname, closing connection";
|
||||
CommandDelete(undef, $cname);
|
||||
}
|
||||
return if(length($hash->{BUF}) < $tlen+$off);
|
||||
|
||||
my $fb = substr($hash->{BUF}, 0, 1);
|
||||
my $pl = substr($hash->{BUF}, $off, $tlen); # payload
|
||||
$hash->{BUF} = substr($hash->{BUF}, $tlen+$off);
|
||||
|
||||
my $cp = ord(substr($fb,0,1)) >> 4;
|
||||
my $cpt = $cptype{$cp};
|
||||
$hash->{lastMsgTime} = gettimeofday();
|
||||
|
||||
#my $pltxt = $pl;
|
||||
#$pltxt =~ s/[^ -~]/./g;
|
||||
#Log3 $sname, 5, "$pltxt";
|
||||
|
||||
if(!$hash->{cid} && $cpt ne "CONNECT") {
|
||||
Log3 $sname, 2, "$cname $cpt before CONNECT, disconnecting";
|
||||
CommandDelete(undef, $cname);
|
||||
return MQTT2_SERVER_Read($hash, 1);
|
||||
}
|
||||
|
||||
####################################
|
||||
if($cpt eq "CONNECT") {
|
||||
($hash->{protoTxt}, $off) = MQTT2_SERVER_getStr($pl, 0); # V3:MQIsdb V4:MQTT
|
||||
$hash->{protoNum} = unpack('C*', substr($pl, $off++, 1));
|
||||
$hash->{cflags} = unpack('C*', substr($pl, $off++, 1));
|
||||
$hash->{keepalive} = unpack('n', substr($pl, $off, 2)); $off += 2;
|
||||
($hash->{cid}, $off) = MQTT2_SERVER_getStr($pl, $off);
|
||||
|
||||
if(!($hash->{cflags} & 0x02)) {
|
||||
Log3 $sname, 2, "$cname wants unclean session, disconnecting";
|
||||
return MQTT2_SERVER_terminate($hash, pack("C*", 0x20, 2, 0, 1));
|
||||
}
|
||||
|
||||
my $desc = "keepAlive:$hash->{keepalive}";
|
||||
if($hash->{cflags} & 0x04) { # Last Will & Testament
|
||||
my ($wt, $wm);
|
||||
($wt, $off) = MQTT2_SERVER_getStr($pl, $off);
|
||||
($wm, $off) = MQTT2_SERVER_getStr($pl, $off);
|
||||
$hash->{lwt} = "$wt:$wm";
|
||||
$desc .= " LWT:$wt:$wm";
|
||||
}
|
||||
|
||||
my ($pwd, $usr) = ("","");
|
||||
if($hash->{cflags} & 0x80) {
|
||||
($usr,$off) = MQTT2_SERVER_getStr($pl,$off);
|
||||
$hash->{usr} = $usr;
|
||||
$desc .= " usr:$hash->{usr}";
|
||||
}
|
||||
|
||||
if($hash->{cflags} & 0x40) {
|
||||
($pwd, $off) = MQTT2_SERVER_getStr($pl,$off);
|
||||
}
|
||||
|
||||
my $ret = Authenticate($hash, "basicAuth:".encode_base64("$usr:$pwd"));
|
||||
return MQTT2_SERVER_terminate($hash, pack("C*", 0x20, 2, 0, 4)) if($ret==2);
|
||||
|
||||
$hash->{subscriptions} = {};
|
||||
$defs{$sname}{clients}{$cname} = 1;
|
||||
|
||||
Log3 $sname, 4, "$cname $hash->{cid} $cpt V:$hash->{protoNum} $desc";
|
||||
addToWritebuffer($hash, pack("C*", 0x20, 2, 0, 0)); # CONNACK, no error
|
||||
|
||||
####################################
|
||||
} elsif($cpt eq "PUBLISH") {
|
||||
my $cf = ord(substr($fb,0,1)) & 0xf;
|
||||
my $qos = ($cf & 0x06) >> 1;
|
||||
my ($tp, $val, $pid);
|
||||
($tp, $off) = MQTT2_SERVER_getStr($pl, 0);
|
||||
if($qos) {
|
||||
$pid = unpack('n', substr($pl, $off, 2));
|
||||
$off += 2;
|
||||
}
|
||||
$val = substr($pl, $off);
|
||||
Log3 $sname, 4, "$cname $hash->{cid} $cpt $tp:$val";
|
||||
addToWritebuffer($hash, pack("CCnC*", 0x40, 2, $pid)) if($qos); # PUBACK
|
||||
MQTT2_SERVER_doPublish($defs{$sname}, $tp, $val, $cname, $cf & 0x01);
|
||||
|
||||
####################################
|
||||
} elsif($cpt eq "SUBSCRIBE") {
|
||||
Log3 $sname, 4, "$cname $hash->{cid} $cpt";
|
||||
my $pid = unpack('n', substr($pl, 0, 2));
|
||||
my ($subscr, @ret);
|
||||
$off = 2;
|
||||
while($off < $tlen) {
|
||||
($subscr, $off) = MQTT2_SERVER_getStr($pl, $off);
|
||||
my $qos = unpack("C*", substr($pl, $off++, 1));
|
||||
$hash->{subscriptions}{$subscr} = $hash->{lastMsgTime};
|
||||
Log3 $sname, 4, " topic:$subscr qos:$qos";
|
||||
push @ret, ($qos > 1 ? 1 : 0); # max qos supported is 1
|
||||
}
|
||||
addToWritebuffer($hash, pack("CCnC*", 0x90, 3, $pid, @ret)); # SUBACK
|
||||
|
||||
if(!$hash->{answerScheduled}) {
|
||||
$hash->{answerScheduled} = 1;
|
||||
InternalTimer($hash->{lastMsgTime}+1, sub(){
|
||||
delete($hash->{answerScheduled});
|
||||
my $r = $defs{$sname}{retain};
|
||||
foreach my $tp (sort { $r->{$a}{ts} <=> $r->{$b}{ts} } keys %{$r}) {
|
||||
MQTT2_SERVER_sendto($hash, $tp, $r->{$tp}{val});
|
||||
}
|
||||
}, undef, 0);
|
||||
}
|
||||
|
||||
|
||||
} elsif($cpt eq "PINGREQ") {
|
||||
Log3 $sname, 4, "$cname $hash->{cid} $cpt";
|
||||
addToWritebuffer($hash, pack("C*", 0xd0, 0)); # pingresp
|
||||
|
||||
} elsif($cpt eq "DISCONNECT") {
|
||||
Log3 $sname, 4, "$cname $hash->{cid} $cpt";
|
||||
CommandDelete(undef, $cname);
|
||||
|
||||
} else {
|
||||
Log 1, "M2: Unhandled packet $cpt, disconneting $cname";
|
||||
CommandDelete(undef, $cname);
|
||||
|
||||
}
|
||||
return MQTT2_SERVER_Read($hash, 1);
|
||||
}
|
||||
|
||||
######################################
|
||||
# Call sendto for all clients + Dispatch + dotrigger if rawEvents is set
|
||||
sub
|
||||
MQTT2_SERVER_doPublish($$$;$$)
|
||||
{
|
||||
my ($hash, $tp, $val, $src, $retain) = @_;
|
||||
$val = "" if(!defined($val));
|
||||
|
||||
if($retain) {
|
||||
my $now = gettimeofday();
|
||||
my %h = ( ts=>$now, val=>$val );
|
||||
$hash->{retain}{$tp} = \%h;
|
||||
}
|
||||
|
||||
foreach my $clName (keys $hash->{clients}) {
|
||||
MQTT2_SERVER_sendto($defs{$clName}, $tp, $val) if(!$src || $src ne $clName);
|
||||
}
|
||||
|
||||
Dispatch($hash, "$tp:$val", undef, 1);
|
||||
|
||||
my $re = AttrVal($hash->{NAME}, "rawEvents", undef);
|
||||
DoTrigger($hash->{NAME}, "$tp:$val") if($re && $tp =~ m/$re/);
|
||||
}
|
||||
|
||||
######################################
|
||||
# send topic to client if its subscription matches the topic
|
||||
sub
|
||||
MQTT2_SERVER_sendto($$$)
|
||||
{
|
||||
my ($hash, $topic, $val) = @_;
|
||||
return if(IsDisabled($hash->{NAME}));
|
||||
$val = "" if(!defined($val));
|
||||
foreach my $s (keys $hash->{subscriptions}) {
|
||||
my $re = $s;
|
||||
$re =~ s,/?#,\\b.*,g;
|
||||
$re =~ s,\+,\\b[^/]+\\b,g;
|
||||
if($topic =~ m/^$re$/) {
|
||||
addToWritebuffer($hash,
|
||||
pack("C",0x30).
|
||||
MQTT2_SERVER_calcRemainingLength(2+length($topic)+length($val)).
|
||||
pack("n", length($topic)).
|
||||
$topic.$val);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub
|
||||
MQTT2_SERVER_terminate($$)
|
||||
{
|
||||
my ($hash,$msg) = @_;
|
||||
addToWritebuffer( $hash, $msg, sub{ CommandDelete(undef, $hash->{NAME}); });
|
||||
}
|
||||
|
||||
sub
|
||||
MQTT2_SERVER_Write($$$)
|
||||
{
|
||||
my ($hash,$topic,$msg) = @_;
|
||||
MQTT2_SERVER_doPublish($hash, $topic, $msg);
|
||||
}
|
||||
|
||||
sub
|
||||
MQTT2_SERVER_calcRemainingLength($)
|
||||
{
|
||||
my ($l) = @_;
|
||||
my @r;
|
||||
while($l > 0) {
|
||||
unshift(@r, $l % 128);
|
||||
$l = int($l/128);
|
||||
}
|
||||
return pack("C*", @r);
|
||||
}
|
||||
|
||||
sub
|
||||
MQTT2_SERVER_getRemainingLength($)
|
||||
{
|
||||
my ($hash) = @_;
|
||||
return (2,2) if(length($hash->{BUF}) < 2);
|
||||
|
||||
my $ret = 0;
|
||||
my $mul = 1;
|
||||
for(my $off = 1; $off <= 4; $off++) {
|
||||
my $b = ord(substr($hash->{BUF},$off,1));
|
||||
$ret += ($b & 0x7f)*$mul;
|
||||
return ($ret, $off+1) if(($b & 0x80) == 0);
|
||||
$mul *= 128;
|
||||
}
|
||||
return -1;
|
||||
}
|
||||
|
||||
sub
|
||||
MQTT2_SERVER_getStr($$)
|
||||
{
|
||||
my ($in, $off) = @_;
|
||||
my $l = unpack("n", substr($in, $off, 2));
|
||||
return (substr($in, $off+2, $l), $off+2+$l);
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
=pod
|
||||
=item helper
|
||||
=item summary Standalone MQTT message broker
|
||||
=item summary_DE Standalone MQTT message broker
|
||||
=begin html
|
||||
|
||||
<a name="MQTT2_SERVER"></a>
|
||||
<h3>MQTT2_SERVER</h3>
|
||||
<ul>
|
||||
MQTT2_SERVER is a builtin/cleanroom implementation of an MQTT server using no
|
||||
external libraries. It serves as an IODev to MQTT2_DEVICES, but may be used
|
||||
as a replacement for standalone servers like mosquitto (with less features
|
||||
and performance). It is intended to simplify connecting MQTT devices to FHEM.
|
||||
<br> <br>
|
||||
|
||||
<a name="MQTT2_SERVERdefine"></a>
|
||||
<b>Define</b>
|
||||
<ul>
|
||||
<code>define <name> MQTT2_SERVER <tcp-portnr> [global|IP]</code>
|
||||
<br><br>
|
||||
Enable the server on port <tcp-portnr>. If global is specified,
|
||||
then requests from all interfaces (not only localhost / 127.0.0.1) are
|
||||
serviced. If IP is specified, then FHEMWEB will only listen on this IP.<br>
|
||||
To enable listening on IPV6 see the comments <a href="#telnet">here</a>.
|
||||
<br>
|
||||
Notes:<br>
|
||||
<ul>
|
||||
<li>to set user/password use an allowed instance and its basicAuth
|
||||
feature (set/attr)</li>
|
||||
<li>retained messages are lost after a FHEM restart</li>
|
||||
<li>the retain flag is not propagated by publish</li>
|
||||
<li>only QOS 0 and 1 is implemented</li>
|
||||
</ul>
|
||||
</ul>
|
||||
<br>
|
||||
|
||||
<a name="MQTT2_SERVERset"></a>
|
||||
<b>Set</b>
|
||||
<ul>
|
||||
<li>publish -r topic value<br>
|
||||
publish a message, -r denotes setting the retain flag.
|
||||
</li>
|
||||
</ul>
|
||||
<br>
|
||||
|
||||
<a name="MQTT2_SERVERget"></a>
|
||||
<b>Get</b>
|
||||
<ul>N/A</ul><br>
|
||||
|
||||
<a name="MQTT2_SERVERattr"></a>
|
||||
<b>Attributes</b>
|
||||
<ul>
|
||||
|
||||
<li><a href="#disable">disable</a><br>
|
||||
<a href="#disabledForIntervals">disabledForIntervals</a><br>
|
||||
disable distribution of messages. The server itself will accept and store
|
||||
messages, but not forward them.
|
||||
</li><br>
|
||||
|
||||
<a name="rawEvents"></a>
|
||||
<li>rawEvents <topic-regexp><br>
|
||||
Send all messages as events attributed to this MQTT2_SERVER instance.
|
||||
Should only be used, if there is no MQTT2_DEVICE to process the topic.
|
||||
</li><br>
|
||||
|
||||
<a name="SSL"></a>
|
||||
<li>SSL<br>
|
||||
Enable SSL (i.e. TLS)
|
||||
</li><br>
|
||||
</ul>
|
||||
</ul>
|
||||
=end html
|
||||
|
||||
=cut
|
||||
@ -136,6 +136,7 @@ FHEMWEB_Initialize($)
|
||||
$hash->{NotifyFn}= "FW_Notify";
|
||||
$hash->{AsyncOutputFn} = "FW_AsyncOutput";
|
||||
$hash->{ActivateInformFn} = "FW_ActivateInform";
|
||||
$hash->{CanAuthenticate} = 1;
|
||||
no warnings 'qw';
|
||||
my @attrList = qw(
|
||||
CORS:0,1
|
||||
|
||||
476
fhem/FHEM/10_MQTT2_DEVICE.pm
Normal file
476
fhem/FHEM/10_MQTT2_DEVICE.pm
Normal file
@ -0,0 +1,476 @@
|
||||
##############################################
|
||||
# $Id$
|
||||
package main;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use SetExtensions;
|
||||
|
||||
sub MQTT2_JSON($;$);
|
||||
|
||||
sub
|
||||
MQTT2_DEVICE_Initialize($)
|
||||
{
|
||||
my ($hash) = @_;
|
||||
$hash->{Match} = ".*";
|
||||
$hash->{SetFn} = "MQTT2_DEVICE_Set";
|
||||
$hash->{GetFn} = "MQTT2_DEVICE_Get";
|
||||
$hash->{DefFn} = "MQTT2_DEVICE_Define";
|
||||
$hash->{UndefFn} = "MQTT2_DEVICE_Undef";
|
||||
$hash->{AttrFn} = "MQTT2_DEVICE_Attr";
|
||||
$hash->{ParseFn} = "MQTT2_DEVICE_Parse";
|
||||
$hash->{RenameFn} = "MQTT2_DEVICE_Rename";
|
||||
|
||||
no warnings 'qw';
|
||||
my @attrList = qw(
|
||||
IODev
|
||||
disable:0,1
|
||||
disabledForIntervals
|
||||
readingList:textField-long
|
||||
setList:textField-long
|
||||
getList:textField-long
|
||||
);
|
||||
use warnings 'qw';
|
||||
$hash->{AttrList} = join(" ", @attrList)." ".$readingFnAttributes;
|
||||
$modules{MQTT2_DEVICE}{defptr} = ();
|
||||
}
|
||||
|
||||
|
||||
#############################
|
||||
sub
|
||||
MQTT2_DEVICE_Define($$)
|
||||
{
|
||||
my ($hash, $def) = @_;
|
||||
my @a = split("[ \t][ \t]*", $def);
|
||||
my $name = shift @a;
|
||||
my $type = shift @a; # always MQTT2_DEVICE
|
||||
|
||||
return "wrong syntax for $name: define <name> MQTT2_DEVICE" if(int(@a));
|
||||
|
||||
AssignIoPort($hash);
|
||||
return undef;
|
||||
}
|
||||
|
||||
#############################
|
||||
sub
|
||||
MQTT2_DEVICE_Parse($$)
|
||||
{
|
||||
my ($iodev, $msg) = @_;
|
||||
my $ioname = $iodev->{NAME};
|
||||
my @ret;
|
||||
|
||||
sub
|
||||
checkForGet($$$)
|
||||
{
|
||||
my ($hash, $key, $value) = @_;
|
||||
if($hash->{asyncGet} && $key eq $hash->{asyncGet}{reading}) {
|
||||
RemoveInternalTimer($hash->{asyncGet});
|
||||
asyncOutput($hash->{asyncGet}{CL}, "$key $value");
|
||||
delete($hash->{asyncGet});
|
||||
}
|
||||
}
|
||||
|
||||
my ($topic, $value) = split(":", $msg, 2);
|
||||
my $dp = $modules{MQTT2_DEVICE}{defptr};
|
||||
foreach my $re (keys %{$dp}) {
|
||||
next if($msg !~ m/^$re$/s);
|
||||
foreach my $dev (keys %{$dp->{$re}}) {
|
||||
next if(IsDisabled($dev));
|
||||
my @retData;
|
||||
my $code = $dp->{$re}{$dev};
|
||||
Log3 $dev, 4, "MQTT2_DEVICE_Parse: $dev $topic => $code";
|
||||
my $hash = $defs{$dev};
|
||||
|
||||
if($code =~ m/^{.*}$/s) {
|
||||
$code = EvalSpecials($code, ("%TOPIC"=>$topic, "%EVENT"=>$value));
|
||||
my $ret = AnalyzePerlCommand(undef, $code);
|
||||
readingsBeginUpdate($hash);
|
||||
foreach my $k (keys %{$ret}) {
|
||||
readingsBulkUpdate($hash, $k, $ret->{$k});
|
||||
push(@retData, "$k $ret->{$k}");
|
||||
checkForGet($hash, $k, $ret->{$k});
|
||||
}
|
||||
readingsEndUpdate($hash, 1);
|
||||
|
||||
} else {
|
||||
readingsSingleUpdate($hash, $code, $value, 1);
|
||||
push(@retData, "$code $value");
|
||||
checkForGet($hash, $code, $value);
|
||||
}
|
||||
|
||||
push @ret, $dev;
|
||||
}
|
||||
}
|
||||
|
||||
return @ret;
|
||||
}
|
||||
|
||||
#############################
|
||||
# simple json reading parser
|
||||
sub
|
||||
MQTT2_JSON($;$)
|
||||
{
|
||||
my ($in,$prefix) = @_;
|
||||
$prefix = "" if(!defined($prefix));
|
||||
my %ret;
|
||||
|
||||
sub
|
||||
lquote($)
|
||||
{
|
||||
my ($t) = @_;
|
||||
my $esc;
|
||||
for(my $off = 1; $off < length($t); $off++){
|
||||
my $s = substr($t,$off,1);
|
||||
if($s eq '\\') {
|
||||
$esc = !$esc;
|
||||
} elsif($s eq '"' && !$esc) {
|
||||
return (substr($t,1,$off-1), substr($t,$off+1));
|
||||
} else {
|
||||
$esc = 0;
|
||||
}
|
||||
}
|
||||
return ($t, ""); # error
|
||||
}
|
||||
|
||||
sub
|
||||
lhash($)
|
||||
{
|
||||
my ($t) = @_;
|
||||
my $depth=1;
|
||||
my ($esc, $inquote);
|
||||
|
||||
for(my $off = 1; $off < length($t); $off++){
|
||||
my $s = substr($t,$off,1);
|
||||
if($s eq '}') {
|
||||
$depth--;
|
||||
return (substr($t,1,$off-1), substr($t,$off+1)) if(!$depth);
|
||||
|
||||
} elsif($s eq '{' && !$inquote) {
|
||||
$depth++;
|
||||
|
||||
} elsif($s eq '"' && !$esc) {
|
||||
$inquote = !$inquote;
|
||||
|
||||
} elsif($s eq '\\') {
|
||||
$esc = !$esc;
|
||||
|
||||
} else {
|
||||
$esc = 0;
|
||||
}
|
||||
}
|
||||
return ($t, ""); # error
|
||||
}
|
||||
|
||||
$in = $1 if($in =~ m/^{(.*)}$/s);
|
||||
|
||||
while($in =~ m/^"([^"]+)"\s*:\s*(.*)$/s) {
|
||||
my ($name,$val) = ($1,$2);
|
||||
$name =~ s/[^a-z0-9._\-\/]/_/gsi;
|
||||
|
||||
if($val =~ m/^"/) {
|
||||
($val, $in) = lquote($val);
|
||||
$ret{"$prefix$name"} = $val;
|
||||
|
||||
} elsif($val =~ m/^{/) { # }
|
||||
($val, $in) = lhash($val);
|
||||
my $r2 = MQTT2_JSON($val);
|
||||
foreach my $k (keys %{$r2}) {
|
||||
$ret{"$prefix${name}_$k"} = $r2->{$k};
|
||||
}
|
||||
|
||||
} elsif($val =~ m/^([0-9.-]+)(.*)$/s) {
|
||||
$ret{"$prefix$name"} = $1;
|
||||
$in = $2;
|
||||
|
||||
} else {
|
||||
Log 1, "Error parsing $val";
|
||||
$in = "";
|
||||
}
|
||||
|
||||
$in =~ s/^\s*,\s*//;
|
||||
}
|
||||
return \%ret;
|
||||
}
|
||||
|
||||
|
||||
#############################
|
||||
sub
|
||||
MQTT2_DEVICE_Get($@)
|
||||
{
|
||||
my ($hash, @a) = @_;
|
||||
return "Not enough arguments for get" if(!defined($a[1]));
|
||||
|
||||
my %gets;
|
||||
map { my ($k,$v) = split(" ",$_,2); $gets{$k} = $v; }
|
||||
split("\n", AttrVal($hash->{NAME}, "getList", ""));
|
||||
return "Unknown argument $a[1], choose one of ".join(" ",sort keys %gets)
|
||||
if(!$gets{$a[1]});
|
||||
return undef if(IsDisabled($hash->{NAME}));
|
||||
|
||||
my ($getReading, $cmd) = split(" ",$gets{$a[1]},2);
|
||||
if($hash->{CL}) {
|
||||
my $tHash = { hash=>$hash, CL=>$hash->{CL}, reading=>$getReading };
|
||||
$hash->{asyncGet} = $tHash;
|
||||
InternalTimer(gettimeofday()+4, sub {
|
||||
asyncOutput($tHash->{CL}, "Timeout reading answer for $cmd");
|
||||
delete($hash->{asyncGet});
|
||||
}, $tHash, 0);
|
||||
}
|
||||
|
||||
shift @a;
|
||||
if($cmd =~ m/^{.*}$/) {
|
||||
$cmd = EvalSpecials($cmd, ("%EVENT"=>join(" ",@a)));
|
||||
$cmd = AnalyzeCommandChain($hash->{CL}, $cmd);
|
||||
return if(!$cmd);
|
||||
} else {
|
||||
shift @a;
|
||||
$cmd .= " ".join(" ",@a) if(@a);
|
||||
}
|
||||
|
||||
IOWrite($hash, split(" ",$cmd,2));
|
||||
return undef;
|
||||
}
|
||||
|
||||
#############################
|
||||
sub
|
||||
MQTT2_DEVICE_Set($@)
|
||||
{
|
||||
my ($hash, @a) = @_;
|
||||
return "Not enough arguments for set" if(!defined($a[1]));
|
||||
|
||||
my %sets;
|
||||
map { my ($k,$v) = split(" ",$_,2); $sets{$k} = $v; }
|
||||
split("\n", AttrVal($hash->{NAME}, "setList", ""));
|
||||
my $cmd = $sets{$a[1]};
|
||||
return SetExtensions($hash, join(" ", sort keys %sets), @a) if(!$cmd);
|
||||
return undef if(IsDisabled($hash->{NAME}));
|
||||
|
||||
shift @a;
|
||||
if($cmd =~ m/^{.*}$/) {
|
||||
$cmd = EvalSpecials($cmd, ("%EVENT"=>join(" ",@a)));
|
||||
$cmd = AnalyzeCommandChain($hash->{CL}, $cmd);
|
||||
return if(!$cmd);
|
||||
} else {
|
||||
shift @a;
|
||||
$cmd .= " ".join(" ",@a) if(@a);
|
||||
}
|
||||
IOWrite($hash, split(" ",$cmd,2));
|
||||
return undef;
|
||||
}
|
||||
|
||||
|
||||
sub
|
||||
MQTT2_DEVICE_Attr($$)
|
||||
{
|
||||
my ($type, $dev, $attrName, $param) = @_;
|
||||
|
||||
if($attrName =~ m/(.*)List/) {
|
||||
my $type = $1;
|
||||
|
||||
if($type eq "del") {
|
||||
MQTT2_DEVICE_delReading($dev) if($type eq "reading");
|
||||
return undef;
|
||||
}
|
||||
|
||||
foreach my $el (split("\n", $param)) {
|
||||
my ($par1, $par2) = split(" ", $el, 2);
|
||||
next if(!$par1);
|
||||
|
||||
(undef, $par2) = split(" ", $par2, 2) if($type eq "get");
|
||||
return "$dev attr $attrName: more parameters needed" if(!$par2);
|
||||
|
||||
if($type eq "reading") {
|
||||
if($par2 =~ m/^{.*}$/) {
|
||||
my $ret = perlSyntaxCheck($par2,
|
||||
("%TOPIC"=>1, "%EVENT"=>"0 1 2 3 4 5 6 7 8 9"));
|
||||
return $ret if($ret);
|
||||
} else {
|
||||
return "unsupported character in readingname $par2"
|
||||
if(!goodReadingName($par2));
|
||||
}
|
||||
|
||||
} else {
|
||||
my $ret = perlSyntaxCheck($par2, ("%EVENT"=>"0 1 2 3 4 5 6 7 8 9"));
|
||||
return $ret if($ret);
|
||||
|
||||
}
|
||||
}
|
||||
MQTT2_DEVICE_addReading($dev, $param) if($type eq "reading");
|
||||
}
|
||||
return undef;
|
||||
}
|
||||
|
||||
sub
|
||||
MQTT2_DEVICE_delReading($)
|
||||
{
|
||||
my ($name) = $_;
|
||||
my $dp = $modules{MQTT2_DEVICE}{defptr};
|
||||
foreach my $re (keys %{$dp}) {
|
||||
if($dp->{$re}{$name}) {
|
||||
delete($dp->{$re}{$name});
|
||||
delete($dp->{$re}) if(!int(keys %{$dp->{$re}}));
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub
|
||||
MQTT2_DEVICE_addReading($$)
|
||||
{
|
||||
my ($name, $param) = @_;
|
||||
foreach my $line (split("\n", $param)) {
|
||||
my ($re,$code) = split(" ", $line,2);
|
||||
$modules{MQTT2_DEVICE}{defptr}{$re}{$name} = $code;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
#####################################
|
||||
sub
|
||||
MQTT2_DEVICE_Rename($$)
|
||||
{
|
||||
my ($new, $old) = @_;
|
||||
MQTT2_DEVICE_delReading($old);
|
||||
MQTT2_DEVICE_addReading($new, AttrVal($old, "readingList", ""));
|
||||
return undef;
|
||||
}
|
||||
|
||||
#####################################
|
||||
sub
|
||||
MQTT2_DEVICE_Undef($$)
|
||||
{
|
||||
my ($hash, $arg) = @_;
|
||||
MQTT2_DEVICE_delReading($arg);
|
||||
return undef;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
=pod
|
||||
=item summary devices communicating via the MQTT2_SERVER
|
||||
=item summary_DE über den MQTT2_SERVER kommunizierende Geräte
|
||||
=begin html
|
||||
|
||||
<a name="MQTT2_DEVICE"></a>
|
||||
<h3>MQTT2_DEVICE</h3>
|
||||
<ul>
|
||||
MQTT2_DEVICE is used to represent single devices connected to the
|
||||
MQTT2_SERVER. MQTT2_SERVER and MQTT2_DEVICE is intended to simplify
|
||||
connecting MQTT devices to FHEM.
|
||||
<br> <br>
|
||||
|
||||
<a name="MQTT2_DEVICEdefine"></a>
|
||||
<b>Define</b>
|
||||
<ul>
|
||||
<code>define <name> MQTT2_DEVICE</code>
|
||||
<br><br>
|
||||
To enable a meaningful function you will need to set at least one of the
|
||||
readingList, setList or getList attributes below.<br>
|
||||
</ul>
|
||||
<br>
|
||||
|
||||
<a name="MQTT2_DEVICEset"></a>
|
||||
<b>Set</b>
|
||||
<ul>
|
||||
see the setList attribute documentation below.
|
||||
</ul>
|
||||
<br>
|
||||
|
||||
<a name="MQTT2_DEVICEget"></a>
|
||||
<b>Get</b>
|
||||
<ul>
|
||||
see the getList attribute documentation below.
|
||||
</ul>
|
||||
<br>
|
||||
|
||||
<a name="MQTT2_DEVICEattr"></a>
|
||||
<b>Attributes</b>
|
||||
<ul>
|
||||
|
||||
<li><a href="#disable">disable</a><br>
|
||||
<a href="#disabledForIntervals">disabledForIntervals</a></li><br>
|
||||
|
||||
<a name="readingList"></a>
|
||||
<li>readingList <topic-regexp> [readingName|perl-Expression] ...<br>
|
||||
On receiving a topic matching the topic-regexp either set readingName to
|
||||
the published message, or evaluate the perl expression, which has to
|
||||
return a hash consisting of readingName=>readingValue entries.
|
||||
You can define multiple such tuples, separated by newline, the newline
|
||||
does not have to be entered in the FHEMWEB frontend.<br>
|
||||
Example:<br>
|
||||
<code>
|
||||
attr dev readingList\<br>
|
||||
myDev/temp temperature\<br>
|
||||
myDev/hum { { humidity=>$EVTPART0 } }<br>
|
||||
</code><br>
|
||||
Notes:
|
||||
<ul>
|
||||
<li>in the perl expression the variables $TOPIC and $EVENT are
|
||||
available (the letter containing the whole message), as well as
|
||||
$EVTPART0, $EVTPART1, ... each containing a single word of the
|
||||
message.</li>
|
||||
<li>the helper function MQTT2_JSON($EVENT) can be used to parse a json
|
||||
encoded value. Importing all values from a Sonoff device with a
|
||||
Tasmota firmware can be done with:
|
||||
<ul><code>
|
||||
attr sonoff_th10 readingList tele/sonoff/S.* { MQTT2_JSON($EVENT) }
|
||||
</code></ul></li>
|
||||
</ul>
|
||||
</li><br>
|
||||
|
||||
<a name="setList"></a>
|
||||
<li>setList cmd [topic|perl-Expression] ...<br>
|
||||
When the FHEM command cmd is issued, publish the topic.
|
||||
Multiple tuples can be specified, each of them separated by newline, the
|
||||
newline does not have to be entered in the FHEMWEB frontend.
|
||||
Example:<br>
|
||||
<code>
|
||||
attr dev setList\<br>
|
||||
on tasmota/sonoff/cmnd/Power1 on\<br>
|
||||
off tasmota/sonoff/cmnd/Power1 off
|
||||
</code><br>
|
||||
This example defines 2 set commands (on and off), which both publish
|
||||
the same topic, but with different messages (arguments).<br>
|
||||
Notes:
|
||||
<ul>
|
||||
<li>Arguments to the set command will be appended to the message
|
||||
published (not for the perl expression)</li>
|
||||
<li>If using a perl expressions, the command arguments are available as
|
||||
$EVENT, $EVTPART0, etc. The perl expression must return a string
|
||||
containing the topic and the message separated by a space.</li>
|
||||
<li>SetExtensions is activated</li>
|
||||
</ul>
|
||||
</li><br>
|
||||
|
||||
<a name="getList"></a>
|
||||
<li>getList cmd reading [topic|perl-Expression] ...<br>
|
||||
When the FHEM command cmd is issued, publish the topic, wait for the
|
||||
answer (the specified reading), and show it in the user interface.
|
||||
Multiple triples can be specified, each of them separated by newline, the
|
||||
newline does not have to be entered in the FHEMWEB frontend.<br>
|
||||
Example:<br>
|
||||
<code>
|
||||
attr dev getList\<br>
|
||||
temp temperature myDev/cmd/getstatus\<br>
|
||||
hum hum myDev/cmd/getStatus
|
||||
</code><br>
|
||||
This example defines 2 get commands (temp and hum), which both publish
|
||||
the same topic, but wait for different readings to be set.<br>
|
||||
Notes:
|
||||
<ul>
|
||||
<li>the readings must be parsed by a readingList</li>
|
||||
<li>get is asynchron, it is intended for frontends like FHEMWEB or
|
||||
telnet, the result cannot be used in self-written perl expressions.
|
||||
Use a set and a notify/DOIF/etc definition for such a purpose</li>
|
||||
<li>arguments to the get command will be appended to the message
|
||||
published (not for the perl expression)</li>
|
||||
<li>if using a perl expressions, the command arguments are available as
|
||||
$EVENT, $EVTPART0, etc. The perl expression must return a string
|
||||
containing the topic and the message separated by a space.</li>
|
||||
</ul>
|
||||
</li><br>
|
||||
|
||||
</ul>
|
||||
</ul>
|
||||
|
||||
=end html
|
||||
=cut
|
||||
@ -5,8 +5,11 @@ package main;
|
||||
use strict;
|
||||
use warnings;
|
||||
use vars qw(@FW_httpheader); # HTTP header, line by line
|
||||
use MIME::Base64;
|
||||
my $allowed_haveSha;
|
||||
|
||||
sub allowed_CheckBasicAuth($$$$@);
|
||||
|
||||
#####################################
|
||||
sub
|
||||
allowed_Initialize($)
|
||||
@ -91,8 +94,6 @@ allowed_Authorize($$$$)
|
||||
stacktrace() if(AttrVal($me, "verbose", 5));
|
||||
return 2;
|
||||
}
|
||||
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
@ -127,34 +128,13 @@ allowed_Authenticate($$$$)
|
||||
}
|
||||
}
|
||||
|
||||
my $pwok = ($secret && $secret eq $basicAuth); # Base64
|
||||
my ($user, $password) = split(":", decode_base64($secret)) if($secret);
|
||||
($user,$password) = ("","") if(!defined($user) || !defined($password));
|
||||
if($secret && $basicAuth =~ m/^{.*}$/) {
|
||||
eval "use MIME::Base64";
|
||||
if($@) {
|
||||
Log3 $aName, 1, $@;
|
||||
|
||||
} else {
|
||||
$pwok = eval $basicAuth;
|
||||
Log3 $aName, 1, "basicAuth expression: $@" if($@);
|
||||
}
|
||||
|
||||
} elsif($basicAuth =~ m/^SHA256:(.{8}):(.*)$/) {
|
||||
if($allowed_haveSha) {
|
||||
$pwok = Digest::SHA::sha256_base64("$1:$user:$password") eq $2;
|
||||
} else {
|
||||
Log3 $me, 3, "Cant load Digest::SHA to decode $me->{NAME} beiscAuth";
|
||||
}
|
||||
|
||||
}
|
||||
Log3 $me, 3, "Login denied by $aName for $user via $cl->{NAME}"
|
||||
if(!$pwok && $user);
|
||||
my $pwok = (allowed_CheckBasicAuth($me, $cl, $secret, $basicAuth, 0) == 1);
|
||||
|
||||
# Add Cookie header ONLY if authentication with basicAuth was succesful
|
||||
if($pwok && (!defined($authcookie) || $secret ne $authcookie)) {
|
||||
my $time = AttrVal($aName, "basicAuthExpiry", 0);
|
||||
if ( $time ) {
|
||||
my ($user, $password) = split(":", decode_base64($secret)) if($secret);
|
||||
$time = int($time*86400+time());
|
||||
# generate timestamp according to RFC-1130 in Expires
|
||||
my $expires = FmtDateTimeRFC1123($time);
|
||||
@ -177,9 +157,8 @@ allowed_Authenticate($$$$)
|
||||
$cl->{".httpAuthHeader"} = "HTTP/1.1 401 Authorization Required\r\n".
|
||||
"WWW-Authenticate: Basic realm=\"$msg\"\r\n";
|
||||
return 2;
|
||||
}
|
||||
|
||||
if($cl->{TYPE} eq "telnet") {
|
||||
} elsif($cl->{TYPE} eq "telnet") {
|
||||
my $pw = AttrVal($aName, "password", undef);
|
||||
if(!$pw) {
|
||||
$pw = AttrVal($aName, "globalpassword", undef);
|
||||
@ -203,11 +182,53 @@ allowed_Authenticate($$$$)
|
||||
}
|
||||
|
||||
return ($pw eq $param) ? 1 : 2;
|
||||
|
||||
} elsif(!$param || ($param && $param =~ m/^basicAuth:(.*)/)) {
|
||||
return allowed_CheckBasicAuth($me, $cl, $1,
|
||||
AttrVal($aName,"basicAuth",undef), $param);
|
||||
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub
|
||||
allowed_CheckBasicAuth($$$$@)
|
||||
{
|
||||
my ($me, $cl, $secret, $basicAuth, $verbose) = @_;
|
||||
|
||||
return 0 if(!$basicAuth);
|
||||
|
||||
my $aName = $me->{NAME};
|
||||
|
||||
my $pwok = ($secret && $secret eq $basicAuth) ? 1 : 2; # Base64
|
||||
my ($user, $password) = split(":", decode_base64($secret)) if($secret);
|
||||
($user,$password) = ("","") if(!defined($user) || !defined($password));
|
||||
|
||||
if($secret && $basicAuth =~ m/^{.*}$/) {
|
||||
$pwok = eval $basicAuth;
|
||||
if($@) {
|
||||
Log3 $aName, 1, "basicAuth expression: $@";
|
||||
$pwok = 2;
|
||||
} else {
|
||||
$pwok = ($pwok ? 1 : 2);
|
||||
}
|
||||
|
||||
} elsif($basicAuth =~ m/^SHA256:(.{8}):(.*)$/) {
|
||||
if($allowed_haveSha) {
|
||||
$pwok = (Digest::SHA::sha256_base64("$1:$user:$password") eq $2 ? 1 : 2);
|
||||
} else {
|
||||
Log3 $me, 3, "Cannot load Digest::SHA to decode $aName basicAuth";
|
||||
$pwok = 2;
|
||||
}
|
||||
|
||||
}
|
||||
Log3 $me, 3, "Login denied by $aName for $user via $cl->{NAME}"
|
||||
if($pwok != 1 && ($verbose || $user));
|
||||
|
||||
return $pwok;
|
||||
}
|
||||
|
||||
|
||||
sub
|
||||
allowed_Set(@)
|
||||
@ -281,13 +302,15 @@ allowed_fhemwebFn($$$$)
|
||||
my $vf = $defs{$d}{validFor} ? $defs{$d}{validFor} : "";
|
||||
my (@F_arr, @t_arr);
|
||||
my @arr = map {
|
||||
push(@F_arr, $_) if($defs{$_}{TYPE} eq "FHEMWEB");
|
||||
push(@t_arr, $_) if($defs{$_}{TYPE} eq "telnet");
|
||||
my $ca = $modules{$defs{$_}{TYPE}}{CanAuthenticate};
|
||||
push(@F_arr, $_) if($ca == 1);
|
||||
push(@t_arr, $_) if($ca == 2);
|
||||
"<input type='checkbox' ".($vf =~ m/\b$_\b/ ? "checked ":"").
|
||||
"name='$_' class='vfAttr'><label>$_</label>"
|
||||
}
|
||||
grep { !$defs{$_}{SNAME} }
|
||||
devspec2array("TYPE=(FHEMWEB|telnet)");
|
||||
grep { !$defs{$_}{SNAME} &&
|
||||
$modules{$defs{$_}{TYPE}}{CanAuthenticate} }
|
||||
sort keys %defs;
|
||||
my $r = "<input id='vfAttr' type='button' value='attr'> $d validFor <ul>".
|
||||
join("<br>",@arr)."</ul><script>var dev='$d';".<<'EOF';
|
||||
$("#vfAttr").click(function(){
|
||||
|
||||
@ -24,6 +24,7 @@ telnet_Initialize($)
|
||||
"allowfrom SSL connectTimeout connectInterval ".
|
||||
"encoding:utf8,latin1 sslVersion";
|
||||
$hash->{ActivateInformFn} = "telnet_ActivateInform";
|
||||
$hash->{CanAuthenticate} = 2;
|
||||
|
||||
$cmds{encoding} = { Fn=>"CommandTelnetEncoding",
|
||||
ClientFilter => "telnet",
|
||||
|
||||
@ -28,6 +28,7 @@ FHEM/00_KM271.pm physikus Sonstiges
|
||||
FHEM/00_LIRC.pm rudolfkoenig Sonstiges
|
||||
FHEM/00_MAXLAN.pm rudolfkoenig/orphan MAX
|
||||
FHEM/00_MQTT.pm eisler MQTT
|
||||
FHEM/00_MQTT2_SERVER.pm rudolfkoenig MQTT
|
||||
FHEM/00_MYSENSORS.pm Hauswart Sonstige Systeme
|
||||
FHEM/00_NetzerI2C.pm klausw Sonstige Systeme
|
||||
FHEM/00_Neuron.pm klausw Sonstige Systeme
|
||||
@ -66,6 +67,7 @@ FHEM/10_KOPP_FC.pm raspii Sonstige Systeme
|
||||
FHEM/10_MAX.pm rudolfkoenig/orphan MAX
|
||||
FHEM/10_MQTT_BRIDGE eisler MQTT
|
||||
FHEM/10_MQTT_DEVICE eisler MQTT
|
||||
FHEM/00_MQTT2_DEVICE.pm rudolfkoenig MQTT
|
||||
FHEM/10_MYSENSORS_DEVICE Hauswart Sonstige Systeme
|
||||
FHEM/10_NeuronPin.pm klausw Sonstige Systeme
|
||||
FHEM/10_OWServer.pm neubert/mfr69bs 1Wire
|
||||
|
||||
19
fhem/fhem.pl
19
fhem/fhem.pl
@ -56,7 +56,7 @@ sub CallInstanceFn(@);
|
||||
sub CheckDuplicate($$@);
|
||||
sub Debug($);
|
||||
sub DoSet(@);
|
||||
sub Dispatch($$$);
|
||||
sub Dispatch($$;$$);
|
||||
sub DoTrigger($$@);
|
||||
sub EvalSpecials($%);
|
||||
sub Each($$;$);
|
||||
@ -2078,6 +2078,7 @@ AssignIoPort($;$)
|
||||
for my $p (sort { $defs{$b}{NR} <=> $defs{$a}{NR} } keys %defs) {
|
||||
|
||||
next if(IsDisabled($p) == 1);
|
||||
next if($defs{$p}{TEMPORARY}); # e.g. server clients
|
||||
my $cl = $defs{$p}{Clients};
|
||||
$cl = $modules{$defs{$p}{TYPE}}{Clients} if(!$cl);
|
||||
|
||||
@ -3751,9 +3752,9 @@ HandleArchiving($;$)
|
||||
# Call a logical device (FS20) ParseMessage with data from a physical device
|
||||
# (FHZ). Note: $hash may be dummy, used by FHEM2FHEM
|
||||
sub
|
||||
Dispatch($$$)
|
||||
Dispatch($$;$$)
|
||||
{
|
||||
my ($hash, $dmsg, $addvals) = @_;
|
||||
my ($hash, $dmsg, $addvals, $nounknown) = @_;
|
||||
my $module = $modules{$hash->{TYPE}};
|
||||
my $name = $hash->{NAME};
|
||||
|
||||
@ -3785,7 +3786,7 @@ Dispatch($$$)
|
||||
last if(int(@found));
|
||||
}
|
||||
|
||||
if(!int(@found) || !defined($found[0])) {
|
||||
if((!int(@found) || !defined($found[0])) && !$nounknown) {
|
||||
my $h = $hash->{MatchList};
|
||||
$h = $module->{MatchList} if(!$h);
|
||||
if(defined($h)) {
|
||||
@ -3815,7 +3816,7 @@ Dispatch($$$)
|
||||
}
|
||||
}
|
||||
}
|
||||
if(!int(@found) || !defined($found[0])) {
|
||||
if((!int(@found) || !defined($found[0])) && !$nounknown) {
|
||||
DoTrigger($name, "UNKNOWNCODE $dmsg");
|
||||
Log3 $name, 3, "$name: Unknown code $dmsg, help me!";
|
||||
return undef;
|
||||
@ -5519,9 +5520,11 @@ SecurityCheck()
|
||||
{
|
||||
return if(AttrVal("global", "motd", "") eq "none");
|
||||
my @fnd;
|
||||
foreach my $sdev (devspec2array("TYPE=(telnet|FHEMWEB)")) {
|
||||
next if(!$defs{$sdev} || $defs{$sdev}{TEMPORARY});
|
||||
my $hash = { SNAME=>$sdev, TYPE=>$defs{$sdev}{TYPE}, NAME=>"SecurityCheck"};
|
||||
foreach my $sdev (keys %defs) {
|
||||
next if($defs{$sdev}{TEMPORARY});
|
||||
my $type = $defs{$sdev}{TYPE};
|
||||
next if(!$modules{$type}{CanAuthenticate});
|
||||
my $hash = { SNAME=>$sdev, TYPE=>$type, NAME=>"SecurityCheck"};
|
||||
push(@fnd, " $sdev is not password protected")
|
||||
if(!Authenticate($hash, undef));
|
||||
}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user