FHEM/fhem-mirror
2
0
Fork 0
mirror of https://github.com/fhem/fhem-mirror.git synced 2025-02-07 23:09:26 +00:00
Code Issues Releases Wiki Activity

00_KNXIO.pm: replace experimental given/when (Forum #127792)

Browse Source 
git-svn-id: https://svn.fhem.de/fhem/trunk@28826 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
erwin 2024-04-27 20:58:27 +00:00
parent 2011eac682
commit 4b61409e10
1 changed files with 180 additions and 161 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

189
fhem/FHEM/00_KNXIO.pm
View File

@ -79,6 +79,8 @@
# modify INITIALIZED logic # modify INITIALIZED logic
# 05/02/2024 modify write queing (mode H) # 05/02/2024 modify write queing (mode H)
# add a few debug msgs # add a few debug msgs
# 25/04/2024 changed _open for mode S
# replaced/removed experimental given/when
package KNXIO; ## no critic 'package' package KNXIO; ## no critic 'package'
@ -92,8 +94,6 @@ use DevIo qw(DevIo_OpenDev DevIo_SimpleWrite DevIo_SimpleRead DevIo_CloseDev Dev
use TcpServerUtils qw(TcpServer_Open TcpServer_SetLoopbackMode TcpServer_MCastAdd TcpServer_MCastRemove use TcpServerUtils qw(TcpServer_Open TcpServer_SetLoopbackMode TcpServer_MCastAdd TcpServer_MCastRemove
TcpServer_MCastSend TcpServer_MCastRecv TcpServer_Close); TcpServer_MCastSend TcpServer_MCastRecv TcpServer_Close);
use HttpUtils qw(HttpUtils_gethostbyname ip2str); use HttpUtils qw(HttpUtils_gethostbyname ip2str);
use feature qw(switch);
no if $] >= 5.017011, warnings => 'experimental';
use GPUtils qw(GP_Import); # Package Helper Fn use GPUtils qw(GP_Import); # Package Helper Fn
### perlcritic parameters ### perlcritic parameters
@ -422,57 +422,17 @@ sub KNXIO_ReadH {
my $errcode = 0; my $errcode = 0;
my $responseID = unpack('x2n',$buf); my $responseID = unpack('x2n',$buf);
given ($responseID) { my %resIDs = (
# handle most frequent id's first 0x0202 => sub { # Search response
when (0x0420) { # Tunnel request
($ccid,$rxseqcntr) = unpack('x7CC',$buf);
my $discardFrame = undef;
if ($rxseqcntr == ($hash->{KNXIOhelper}->{SEQUENCECNTR} - 1)) {
KNXIO_Log ($name, 3, q{TunnelRequest received: duplicate message received } .
qq{(seqcntr= $rxseqcntr ) - ack it});
$hash->{KNXIOhelper}->{SEQUENCECNTR}--; # one packet duplicate... we ack it but do not process
$discardFrame = 1;
}
if ($rxseqcntr != $hash->{KNXIOhelper}->{SEQUENCECNTR}) { # really out of sequence
KNXIO_Log ($name, 3, q{TunnelRequest received: out of sequence, } .
qq{(seqcntrRx= $rxseqcntr seqcntrTx= $hash->{KNXIOhelper}->{SEQUENCECNTR} ) - no ack & discard});
return;
}
KNXIO_Log ($name, 4, q{TunnelRequest received - send Ack and decode. } .
qq{seqcntrRx= $hash->{KNXIOhelper}->{SEQUENCECNTR}} ) if (! defined($discardFrame));
my $tacksend = pack('nnnCCCC',0x0610,0x0421,10,4,$ccid,$hash->{KNXIOhelper}->{SEQUENCECNTR},0); # send ack
$hash->{KNXIOhelper}->{SEQUENCECNTR}++;
$hash->{KNXIOhelper}->{SEQUENCECNTR} = 0 if ($hash->{KNXIOhelper}->{SEQUENCECNTR} > 255);
::DevIo_SimpleWrite($hash,$tacksend,0);
return if ($discardFrame); # duplicate frame
#now decode & send to clients
$buf = substr($buf,10); # strip off header (10 bytes)
my $cemiRes = KNXIO_decodeCEMI($hash,$buf);
return if (! defined($cemiRes));
return KNXIO_dispatch($hash,$cemiRes);
}
when (0x0421) { # Tunneling Ack
($ccid,$txseqcntr,$errcode) = unpack('x7CCC',$buf);
if ($errcode > 0) {
KNXIO_Log ($name, 3, qq{Tunneling Ack received CCID= $ccid txseq= $txseqcntr Status= } . KNXIO_errCodes($errcode));
#what next ?
}
$hash->{KNXIOhelper}->{SEQUENCECNTR_W} = ($txseqcntr + 1) % 256;
KNXIO_Debug ($name, 1, q{Tunnel ack received } . sprintf('%02x', $txseqcntr));
return RemoveInternalTimer($hash,\&KNXIO_TunnelRequestTO); # all ok, stop timer
}
when (0x0202) { # Search response
KNXIO_Log ($name, 4, 'SearchResponse received'); KNXIO_Log ($name, 4, 'SearchResponse received');
my (@contolpointIp, $controlpointPort) = unpack('x6CCCn',$buf); my (@contolpointIp, $controlpointPort) = unpack('x6CCCn',$buf);
return; return;
} },
when (0x0204) { # Decription response 0x0204 => sub { # Decription response
KNXIO_Log ($name, 4, 'DescriptionResponse received'); KNXIO_Log ($name, 4, 'DescriptionResponse received');
return; return;
} },
when (0x0206) { # Connection response 0x0206 => sub { # Connection response
($hash->{KNXIOhelper}->{CCID},$errcode) = unpack('x6CC',$buf); # save Comm Channel ID,errcode ($hash->{KNXIOhelper}->{CCID},$errcode) = unpack('x6CC',$buf); # save Comm Channel ID,errcode
RemoveInternalTimer($hash,\&KNXIO_keepAlive); RemoveInternalTimer($hash,\&KNXIO_keepAlive);
if ($errcode > 0) { if ($errcode > 0) {
@ -486,9 +446,10 @@ sub KNXIO_ReadH {
KNXIO_handleConn($hash); KNXIO_handleConn($hash);
$hash->{KNXIOhelper}->{SEQUENCECNTR} = 0; $hash->{KNXIOhelper}->{SEQUENCECNTR} = 0;
return InternalTimer(gettimeofday() + 60, \&KNXIO_keepAlive, $hash); # start keepalive InternalTimer(gettimeofday() + 60, \&KNXIO_keepAlive, $hash); # start keepalive
} return;
when (0x0208) { # ConnectionState response },
0x0208 => sub { # ConnectionState response
($hash->{KNXIOhelper}->{CCID}, $errcode) = unpack('x6CC',$buf); ($hash->{KNXIOhelper}->{CCID}, $errcode) = unpack('x6CC',$buf);
RemoveInternalTimer($hash,\&KNXIO_keepAlive); RemoveInternalTimer($hash,\&KNXIO_keepAlive);
RemoveInternalTimer($hash,\&KNXIO_keepAliveTO); # reset timeout timer RemoveInternalTimer($hash,\&KNXIO_keepAliveTO); # reset timeout timer
@ -498,24 +459,71 @@ sub KNXIO_ReadH {
KNXIO_disconnect($hash,2); KNXIO_disconnect($hash,2);
return; return;
} }
return InternalTimer(gettimeofday() + 60, \&KNXIO_keepAlive, $hash); InternalTimer(gettimeofday() + 60, \&KNXIO_keepAlive, $hash);
} return;
when (0x0209) { # Disconnect request },
0x0209 => sub { # Disconnect request
KNXIO_Log ($name, 4, ' DisconnectRequest received, restarting connection'); KNXIO_Log ($name, 4, ' DisconnectRequest received, restarting connection');
$ccid = unpack('x6C',$buf); $ccid = unpack('x6C',$buf);
$msg = pack('nnnCC',(0x0610,0x020A,8,$ccid,0)); $msg = pack('nnnCC',(0x0610,0x020A,8,$ccid,0));
::DevIo_SimpleWrite($hash,$msg,0); # send disco response ::DevIo_SimpleWrite($hash,$msg,0); # send disco response
$msg = KNXIO_prepareConnRequ($hash); $msg = KNXIO_prepareConnRequ($hash);
} return $msg;
when (0x020A) { # Disconnect response },
0x020A => sub { # Disconnect response
KNXIO_Log ($name, 4, 'DisconnectResponse received - sending connrequ'); KNXIO_Log ($name, 4, 'DisconnectResponse received - sending connrequ');
$msg = KNXIO_prepareConnRequ($hash); $msg = KNXIO_prepareConnRequ($hash);
return $msg;
},
0x0420 => sub { # Tunnel request
($ccid,$rxseqcntr) = unpack('x7CC',$buf);
my $discardFrame = undef;
my $cntrdiff = $rxseqcntr - $hash->{KNXIOhelper}->{SEQUENCECNTR};
if ($cntrdiff == -1) {
KNXIO_Log ($name, 3, q{TunnelRequest duplicate message received: } .
qq{(seqcntr= $rxseqcntr ) - ack it});
$discardFrame = 1; # one packet duplicate... we ack it but do not process
} }
default { elsif ($cntrdiff != 0) { # really out of sequence
KNXIO_Log ($name, 3, q{TunnelRequest messaage out of sequence received: } .
qq{(seqcntrRx= $rxseqcntr seqcntrTx= $hash->{KNXIOhelper}->{SEQUENCECNTR} ) - no ack & discard});
return;
}
KNXIO_Log ($name, 4, q{TunnelRequest received - send Ack and decode. } .
qq{seqcntrRx= $hash->{KNXIOhelper}->{SEQUENCECNTR}} ) if (! defined($discardFrame));
my $tacksend = pack('nnnCCCC',0x0610,0x0421,10,4,$ccid,$rxseqcntr,0); # send ack
$hash->{KNXIOhelper}->{SEQUENCECNTR} = ($rxseqcntr + 1) % 256;
::DevIo_SimpleWrite($hash,$tacksend,0);
return if ($discardFrame); # duplicate frame
#now decode & send to clients
$buf = substr($buf,10); # strip off header (10 bytes)
my $cemiRes = KNXIO_decodeCEMI($hash,$buf);
return if (! defined($cemiRes));
KNXIO_dispatch($hash,$cemiRes);
return;
},
0x0421 => sub { # Tunneling Ack
($ccid,$txseqcntr,$errcode) = unpack('x7CCC',$buf);
if ($errcode > 0) {
KNXIO_Log ($name, 3, qq{Tunneling Ack received CCID= $ccid txseq= $txseqcntr Status= } . KNXIO_errCodes($errcode));
#what next ?
}
$hash->{KNXIOhelper}->{SEQUENCECNTR_W} = ($txseqcntr + 1) % 256;
KNXIO_Debug ($name, 1, q{Tunnel ack received } . sprintf('%02x', $txseqcntr));
RemoveInternalTimer($hash,\&KNXIO_TunnelRequestTO); # all ok, stop timer
return;
},
); # %resIDs
if (exists($resIDs{$responseID})) {
$msg = &{$resIDs{$responseID}} ($buf);
} else {
KNXIO_Log ($name, 3, 'invalid response received: ' . unpack('H*',$buf)); KNXIO_Log ($name, 3, 'invalid response received: ' . unpack('H*',$buf));
return; return;
} }
}
::DevIo_SimpleWrite($hash,$msg,0) if(defined($msg)); # send msg ::DevIo_SimpleWrite($hash,$msg,0) if(defined($msg)); # send msg
return; return;
} }
@ -626,20 +634,30 @@ sub KNXIO_Write2 {
my $ret = 0; my $ret = 0;
my $mode = $hash->{model}; my $mode = $hash->{model};
my $gadoffset; # offset to gad in msg - debug only
my $dataoffset; # offset to data in msg - debug only
if ($mode eq 'H') { if ($mode eq 'H') {
# replace sequence counterW # replace sequence counterW
substr($msg,8,1) = pack('C',$hash->{KNXIOhelper}->{SEQUENCECNTR_W}); ##no critic (BuiltinFunctions::ProhibitLvalueSubstr) substr($msg,8,1) = pack('C',$hash->{KNXIOhelper}->{SEQUENCECNTR_W}); ##no critic (BuiltinFunctions::ProhibitLvalueSubstr)
# $msg = substr($msg,0,8) . pack('C',$hash->{KNXIOhelper}->{SEQUENCECNTR_W}) . substr($msg,9); # w.o. LvalueSubstr PBP ! # $msg = substr($msg,0,8) . pack('C',$hash->{KNXIOhelper}->{SEQUENCECNTR_W}) . substr($msg,9); # w.o. LvalueSubstr PBP !
$ret = ::DevIo_SimpleWrite($hash,$msg,0);
# Timeout function - expect TunnelAck within 1 sec! - but if fhem has a delay.... # Timeout function - expect TunnelAck within 1 sec! - but if fhem has a delay....
$hash->{KNXIOhelper}->{LASTSENTMSG} = unpack('H*',$msg); # save msg for resend in case of TO $hash->{KNXIOhelper}->{LASTSENTMSG} = unpack('H*',$msg); # save msg for resend in case of TO
InternalTimer($timenow + 1.5, \&KNXIO_TunnelRequestTO, $hash); InternalTimer($timenow + 1.5, \&KNXIO_TunnelRequestTO, $hash);
$gadoffset = 16;
$dataoffset = $gadoffset + 4;
} }
if ($mode eq 'M') { elsif ($mode eq 'M') {
$ret = ::TcpServer_MCastSend($hash,$msg); $ret = ::TcpServer_MCastSend($hash,$msg);
$gadoffset = 12;
$dataoffset = $gadoffset + 4;
} }
else { else { # mode ST
$ret = ::DevIo_SimpleWrite($hash,$msg,0); $ret = ::DevIo_SimpleWrite($hash,$msg,0);
$gadoffset = 4;
$dataoffset = $gadoffset + 3;
} }
$count--; $count--;
@ -650,9 +668,8 @@ sub KNXIO_Write2 {
RemoveInternalTimer($hash, \&KNXIO_Flooding); RemoveInternalTimer($hash, \&KNXIO_Flooding);
} }
KNXIO_Log ($name, 5, qq{Mode= $mode buf=} . unpack('H*',$msg) . qq{ rc= $ret}); KNXIO_Log ($name, 5, qq{Mode= $mode buf=} . unpack('H*',$msg) . qq{ rc= $ret});
my $idx = ($mode eq 'H')?16:12; # offset for dst-addr KNXIO_Debug ($name, 1, q{IO-write processed- gad= } . KNXIO_addr2hex(unpack('n',substr($msg,$gadoffset,2)),3) .
KNXIO_Debug ($name, 1, q{IO-write processed- gad= } . KNXIO_addr2hex(unpack('n',substr($msg,$idx,2)),3) . q{ msg= } . q{ msg= } . unpack('H*',substr($msg,$dataoffset)) . qq{ msg-remain= $count});
unpack('H*',substr($msg,$idx+4)) . qq{ msg-remain= $count});
return; return;
} }
@ -719,21 +736,27 @@ sub KNXIO_Set {
my $name = shift; my $name = shift;
my $cmd = shift; my $cmd = shift;
return q{no cmd specified for set cmd} if (!defined($cmd));
my $adddelay = 1.0; my $adddelay = 1.0;
given ($cmd) { if (!defined($cmd)) { return q{no arg specified for set cmd}; }
when (q{?}) { return qq{unknown argument $cmd choose one of $setcmds}; } if ($cmd eq q{?}) { return qq{unknown argument $cmd choose one of $setcmds}; }
when (q{disconnect}) { return KNXIO_closeDev($hash); } if ($cmd eq q{disconnect}) { return KNXIO_closeDev($hash); }
when (q{connect}) { if ($cmd eq q{connect}) {
return qq{$name is connected, no action taken} if (ReadingsVal($name,'state','disconnected') eq 'connected'); if (ReadingsVal($name,'state','disconnected') eq 'connected') {
return qq{$name is connected, no action taken};
} }
when (q{restart}) { elsif (AttrVal($name,'disable',0) == 1) {
return qq{$name is disabled, no action taken};
}
}
elsif ($cmd eq q{restart}) {
KNXIO_closeDev($hash); KNXIO_closeDev($hash);
$adddelay = 5.0; $adddelay = 5.0;
} }
default { return qq{invalid set cmd $cmd}; } else {
return qq{invalid set cmd $cmd};
} }
InternalTimer(gettimeofday() + $adddelay, \&KNXIO_openDev, $hash); InternalTimer(gettimeofday() + $adddelay, \&KNXIO_openDev, $hash);
return; return;
} }
@ -814,9 +837,7 @@ sub KNXIO_openDev {
my $ret = undef; # result my $ret = undef; # result
delete $hash->{stacktrace}; # clean start delete $hash->{stacktrace}; # clean start
given ($mode) { if ($mode eq q{M}) { ### multicast support via TcpServerUtils
### multicast support via TcpServerUtils ...
when ('M') {
delete $hash->{TCPDev}; # devio ? delete $hash->{TCPDev}; # devio ?
$ret = ::TcpServer_Open($hash, $port, $host, 1); $ret = ::TcpServer_Open($hash, $port, $host, 1);
if (defined($ret)) { # error if (defined($ret)) { # error
@ -825,7 +846,7 @@ sub KNXIO_openDev {
} }
$ret = ::TcpServer_MCastAdd($hash,$host); $ret = ::TcpServer_MCastAdd($hash,$host);
if (defined($ret)) { # error if (defined($ret)) { # error
KNXIO_Log ($name, 2, qq{MC add failed: $ret}) if(!$reopen); KNXIO_Log ($name, 2, qq{MC add failed: $ret});
return qq{KNXIO_openDev ($name): MC add failed: $ret}; return qq{KNXIO_openDev ($name): MC add failed: $ret};
} }
@ -836,17 +857,17 @@ sub KNXIO_openDev {
$ret = KNXIO_init($hash); $ret = KNXIO_init($hash);
} }
### socket mode if ($mode eq q{S}) { ### socket mode
when ('S') {
if (!(-S -r -w $spath) ) { if (!(-S -r -w $spath) ) {
KNXIO_Log ($name, 2, q{Socket not available - (knxd running?)}); KNXIO_Log ($name, 2, q{Socket not available - (knxd running?)});
KNXIO_disconnect($hash, 30);
readingsSingleUpdate($hash, 'state', 'disconnected', 1);
return qq{KNXIO_openDev ($name): Socket not available - (knxd running?)}; return qq{KNXIO_openDev ($name): Socket not available - (knxd running?)};
} }
$ret = ::DevIo_OpenDev($hash,$reopen,\&KNXIO_init); # no callback $ret = ::DevIo_OpenDev($hash,$reopen,\&KNXIO_init); # no callback
} }
### host udp if ($mode eq q{H}) { ### host udp
when ('H') {
my $conn = 0; my $conn = 0;
$conn = IO::Socket::INET->new(PeerAddr => "$host:$port", Type => SOCK_DGRAM, Proto => 'udp', Reuse => 1); $conn = IO::Socket::INET->new(PeerAddr => "$host:$port", Type => SOCK_DGRAM, Proto => 'udp', Reuse => 1);
if (!($conn)) { if (!($conn)) {
@ -868,11 +889,9 @@ sub KNXIO_openDev {
$ret = KNXIO_init($hash); $ret = KNXIO_init($hash);
} }
### tunneling TCP if ($mode eq q{T}) { ### tunneling TCP
when ('T') {
$ret = ::DevIo_OpenDev($hash,$reopen,\&KNXIO_init,\&KNXIO_callback); $ret = ::DevIo_OpenDev($hash,$reopen,\&KNXIO_init,\&KNXIO_callback);
} }
} # /given
if(defined($ret) && $ret) { if(defined($ret) && $ret) {
KNXIO_Log ($name, 1, q{Cannot open device - ignoring it}); KNXIO_Log ($name, 1, q{Cannot open device - ignoring it});
@ -935,7 +954,6 @@ sub KNXIO_handleConn {
my $hash = shift; my $hash = shift;
my $name = $hash->{NAME}; my $name = $hash->{NAME};
RemoveInternalTimer($hash, \&KNXIO_openTO) if ($hash->{model} eq q{H}); RemoveInternalTimer($hash, \&KNXIO_openTO) if ($hash->{model} eq q{H});
if (exists($hash->{KNXIOhelper}->{startdone})) { if (exists($hash->{KNXIOhelper}->{startdone})) {
@ -946,7 +964,6 @@ sub KNXIO_handleConn {
else { # fhem start else { # fhem start
KNXIO_Log ($name, 3, q{initial-connect}); KNXIO_Log ($name, 3, q{initial-connect});
readingsSingleUpdate($hash, 'state', 'connected', 0); # no event readingsSingleUpdate($hash, 'state', 'connected', 0); # no event
# $hash->{KNXIOhelper}->{startdone} = 1;
InternalTimer(gettimeofday() + 30, \&KNXIO_initcomplete, $hash); InternalTimer(gettimeofday() + 30, \&KNXIO_initcomplete, $hash);
} }
return; return;
@ -964,8 +981,9 @@ sub KNXIO_initcomplete {
main::KNX_scan('TYPE=KNX:FILTER=IODev=' . $name) if (AttrNum($name,'enableKNXscan',0) >= 1); # on 1st connect only main::KNX_scan('TYPE=KNX:FILTER=IODev=' . $name) if (AttrNum($name,'enableKNXscan',0) >= 1); # on 1st connect only
$hash->{KNXIOhelper}->{startdone} = 1; $hash->{KNXIOhelper}->{startdone} = 1;
DoTrigger($name,'INITIALIZED'); DoTrigger($name,'INITIALIZED');
readingsSingleUpdate($hash, 'state', 'connected', 1); # now do event
} }
elsif (AttrVal($name,'disable','disabled') ne 'disabled') { elsif (AttrVal($name,'disable', 0) != 1) {
KNXIO_Log ($name, 3, q{failed}); KNXIO_Log ($name, 3, q{failed});
} }
return; return;
@ -1341,6 +1359,7 @@ sub KNXIO_Log {
return if ($loglvl > $dloglvl); # shortcut performance return if ($loglvl > $dloglvl); # shortcut performance
my $sub = (caller(1))[3] // 'main'; my $sub = (caller(1))[3] // 'main';
$sub = (caller(2))[3] if ($sub =~ /ANON/xms); # anonymous sub
my $line = (caller(0))[2]; my $line = (caller(0))[2];
$sub =~ s/^.+[:]+//xms; $sub =~ s/^.+[:]+//xms;