diff --git a/fhem/CHANGED b/fhem/CHANGED index 15376997c..337992416 100644 --- a/fhem/CHANGED +++ b/fhem/CHANGED @@ -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 diff --git a/fhem/FHEM/00_MQTT2_SERVER.pm b/fhem/FHEM/00_MQTT2_SERVER.pm new file mode 100644 index 000000000..ae5a4cb8f --- /dev/null +++ b/fhem/FHEM/00_MQTT2_SERVER.pm @@ -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 diff --git a/fhem/FHEM/01_FHEMWEB.pm b/fhem/FHEM/01_FHEMWEB.pm index 9246bbd86..2f38d03d6 100644 --- a/fhem/FHEM/01_FHEMWEB.pm +++ b/fhem/FHEM/01_FHEMWEB.pm @@ -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 diff --git a/fhem/FHEM/10_MQTT2_DEVICE.pm b/fhem/FHEM/10_MQTT2_DEVICE.pm new file mode 100644 index 000000000..4193fd9e7 --- /dev/null +++ b/fhem/FHEM/10_MQTT2_DEVICE.pm @@ -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 diff --git a/fhem/FHEM/96_allowed.pm b/fhem/FHEM/96_allowed.pm index 1fdd4b8d9..b8a378db8 100644 --- a/fhem/FHEM/96_allowed.pm +++ b/fhem/FHEM/96_allowed.pm @@ -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(){ diff --git a/fhem/FHEM/98_telnet.pm b/fhem/FHEM/98_telnet.pm index 7a12ad04a..c6e9d7ef0 100644 --- a/fhem/FHEM/98_telnet.pm +++ b/fhem/FHEM/98_telnet.pm @@ -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", diff --git a/fhem/MAINTAINER.txt b/fhem/MAINTAINER.txt index 6553ea18b..6cdfcfb10 100644 --- a/fhem/MAINTAINER.txt +++ b/fhem/MAINTAINER.txt @@ -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 diff --git a/fhem/fhem.pl b/fhem/fhem.pl index c22adda04..e7db4a6af 100755 --- a/fhem/fhem.pl +++ b/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)); }