FHEM/fhem-mirror
2
0
Fork 0
mirror of https://github.com/fhem/fhem-mirror.git synced 2025-03-03 10:46:53 +00:00
Code Issues Releases Wiki Activity

98_Modbus.pm: fix memory leak as relay or slave

Browse Source 
git-svn-id: https://svn.fhem.de/fhem/trunk@26497 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
StefanStrobel 2022-10-07 17:27:36 +00:00
parent f165005a17
commit b02e92a3c1
1 changed files with 237 additions and 163 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

400
fhem/FHEM/98_Modbus.pm
View File

@ -112,8 +112,7 @@
# more explanations # more explanations
#################### ####################
# # if a logical device uses a physical device as io device, then $hash->{MODE}
# if a logical device uses a serial physical device as io device, then $hash->{MODE}
# is copied to the physical device and locks this device into this mode. # is copied to the physical device and locks this device into this mode.
# #
# $hash->{PROTOCOL} can be RTU, ASCII or TCP # $hash->{PROTOCOL} can be RTU, ASCII or TCP
@ -124,19 +123,18 @@
# phys connection proto mode on physical device # phys connection proto mode on physical device
# #
# serial rtu / ascii master and slave at same time not working, # serial/tcp rtu / ascii master and slave at same time not working,
# slave can not hear master / only one master per line # slave can not hear master / only one master per line
# also master and passive at sime time does not make sense # also master and passive at sime time does not make sense
# also slave and passive is useless # also slave and passive is useless
# so if one logical device is passive, physical device can be locked passive # so if one logical device is passive, physical device can be locked passive
#
# if one is master or slave, physical can be set to same # if one is master or slave, physical can be set to same
# #
# serial rtu / ascii passive possible, physical then can also be locked. # serial rtu / ascii passive possible, physical then can also be locked.
# #
# serial tcp nonsense # serial tcp nonsense
# #
# tcp rtu / ascii passive not possible, only master / slave. phys = logocal # tcp rtu / ascii passive not possible, only master / slave. phys = logical
# tcp same. # tcp same.
# so when definig / assigning iodev, mode can be locked on physical side. # so when definig / assigning iodev, mode can be locked on physical side.
@ -150,14 +148,12 @@
# NotifyFn is triggered at INITIALIZED, REREADCFG and MODIFIED. # NotifyFn is triggered at INITIALIZED, REREADCFG and MODIFIED.
# here ModbusLD_GetIOHash($hash) is called where everything should happen (call register etc.) # here ModbusLD_GetIOHash($hash) is called where everything should happen (call register etc.)
#
# for enable after disable on physical side everything is done. On logical side GetIOHash is called again. # for enable after disable on physical side everything is done. On logical side GetIOHash is called again.
# for attr IODev SetIODev is called # for attr IODev SetIODev is called
# ReadyFn also doesnt change anything regarding IODev / Registration # ReadyFn also doesnt change anything regarding IODev / Registration
# So mainly things are handled after a define / initialized which triggers NotifyFn for every device # So mainly things are handled after a define / initialized which triggers NotifyFn for every device
# Notify calls GetIoHash which calls SetIODev # Notify calls GetIoHash which calls SetIODev
#
# #
# Exprs und Maps # Exprs und Maps
@ -191,6 +187,7 @@ use Scalar::Util qw(looks_like_number);
use TcpServerUtils qw(:all); use TcpServerUtils qw(:all);
use DevIo; use DevIo;
use FHEM::HTTPMOD::Utils qw(:all); use FHEM::HTTPMOD::Utils qw(:all);
use Scalar::Util qw(weaken); # needed for backlinks in queue structures (see chapter 11 in PBP / memory leak reported with relays)
use Exporter ('import'); use Exporter ('import');
our @EXPORT_OK = qw(); our @EXPORT_OK = qw();
@ -267,7 +264,7 @@ BEGIN { # functions / variables needed from package main
}; };
my $Module_Version = '4.4.04 - 17.7.2021'; my $Module_Version = '4.4.11 - 5.10.2022';
my $PhysAttrs = join (' ', my $PhysAttrs = join (' ',
'queueDelay', 'queueDelay',
@ -283,14 +280,15 @@ my $PhysAttrs = join (' ',
'openTimeout', 'openTimeout',
'nextOpenDelay', 'nextOpenDelay',
'nextOpenDelay2', 'nextOpenDelay2',
'maxTimeoutsToReconnect', # for Modbus over TCP/IP only 'maxTimeoutsToReconnect', # for Modbus over TCP/IP only
'skipGarbage:0,1', 'skipGarbage:0,1',
'requestDelay', # for debugging / testing / simulations
'timeoutLogLevel:3,4', 'timeoutLogLevel:3,4',
'closeAfterResponse:0,1', # for Modbus over TCP/IP only 'closeAfterResponse:0,1', # for Modbus over TCP/IP only
'silentReconnect:0,1'); 'silentReconnect:0,1');
my $LogAttrs = join (' ', my $LogAttrs = join (' ',
'IODev', # fhem.pl macht dann $hash->{IODev} = $defs{$ioname} 'IODev', # fhem.pl macht dann $hash->{IODev} = $defs{$ioname}
'queueMax', 'queueMax',
'alignTime', 'alignTime',
'enableControlSet:0,1', 'enableControlSet:0,1',
@ -329,7 +327,7 @@ my $ObjAttrs = join (' ',
'obj-[cdih][0-9]+-expr', 'obj-[cdih][0-9]+-expr',
'obj-[cdih][0-9]+-ignoreExpr', 'obj-[cdih][0-9]+-ignoreExpr',
'obj-[cdih][0-9]+-format', 'obj-[cdih][0-9]+-format',
'obj-[ih][0-9]+-type', 'obj-[cdih][0-9]+-type',
'obj-[cdih][0-9]+-showGet', 'obj-[cdih][0-9]+-showGet',
'obj-[cdih][0-9]+-allowWrite', 'obj-[cdih][0-9]+-allowWrite',
'obj-[cdih][0-9]+-group', 'obj-[cdih][0-9]+-group',
@ -382,7 +380,8 @@ my $DevAttrs = join (' ',
'dev-type-[A-Za-z0-9_]+-set', 'dev-type-[A-Za-z0-9_]+-set',
'dev-timing-timeout', 'dev-timing-timeout',
'dev-timing-serverTimeout', 'dev-timing-serverTimeout',
'dev-timing-serverTimeoutAbs', # just for testing
'dev-timing-sendDelay', 'dev-timing-sendDelay',
'dev-timing-commDelay'); 'dev-timing-commDelay');
@ -557,8 +556,8 @@ sub DefineFn {
$ioHash->{DeviceName} = $dev; # needed by DevIo to get Device, Port, Speed etc. $ioHash->{DeviceName} = $dev; # needed by DevIo to get Device, Port, Speed etc.
$ioHash->{IODev} = $ioHash; # point back to self to make getIOHash easier $ioHash->{IODev} = $ioHash; # point back to self to make getIOHash easier
$ioHash->{NOTIFYDEV} = 'global'; # NotifyFn nur aufrufen wenn global events (INITIALIZED) $ioHash->{NOTIFYDEV} = 'global'; # NotifyFn nur aufrufen wenn global events (INITIALIZED)
DoClose($ioHash);
DoClose($ioHash, 1); # close, set Expect, clear Buffer, but don't set state to disconnected
Log3 $name, 3, "$name: defined as $dev"; Log3 $name, 3, "$name: defined as $dev";
return; # open is done later from NOTIFY return; # open is done later from NOTIFY
} }
@ -638,8 +637,8 @@ sub DefineLDFn {
$hash->{PROTOCOL} = $proto // 'RTU'; $hash->{PROTOCOL} = $proto // 'RTU';
Log3 $name, 3, "$name: defined $mode with id $id, protocol $hash->{PROTOCOL}" . ($logInfo // ''); Log3 $name, 3, "$name: defined $mode with id $id, protocol $hash->{PROTOCOL}" . ($logInfo // '');
# for Modbus TCP physical hash = logical has so MODE is set for physical device as well. # for Modbus TCP physical hash = logical hash so MODE is set for physical device as well.
# for Modbus over serial lines this is set when IODev Attr and GetIOHash is called # for Modbus over IODev this is set when IODev Attr and GetIOHash is called
# or later when it is needed and GetIOHash is called # or later when it is needed and GetIOHash is called
# for TCP $id is an optional Unit ID that is ignored by most devices # for TCP $id is an optional Unit ID that is ignored by most devices
@ -694,16 +693,18 @@ sub UndefFn {
my $name = $ioHash->{NAME}; my $name = $ioHash->{NAME};
# device is already in the process of being deleted so we should not issue commandDelete inside _Close again # device is already in the process of being deleted so we should not issue commandDelete inside _Close again
DoClose($ioHash,1 ,1) if (IsOpen($ioHash)); # close, set Expect, clear Buffer, don't set state, don't delete yet # dont check isOpen, call close even if closed and potentially on readyfn list
DoClose($ioHash, {NODELETE => 1});
# lösche auch die Verweise aus logischen Modulen auf dieses physische. # lösche auch die Verweise aus logischen Modulen auf dieses physische.
foreach my $d (keys %{$ioHash->{defptr}}) { foreach my $d (keys %{$ioHash->{defptr}}) { # go through all logical devices using this physical
Log3 $name, 3, "$name: Undef is removing IO device for $d"; Log3 $name, 3, "$name: Undef is removing IO device for $d";
my $lHash = $defs{$d}; my $lHash = $defs{$d};
delete $lHash->{IODev} if ($lHash); delete $lHash->{IODev} if ($lHash); # remove IODev entry at logical device
UpdateTimer($lHash, \&Modbus::GetUpdate, 'stop'); UpdateTimer($lHash, \&Modbus::GetUpdate, 'stop'); # stop update timer of logical device
} }
Profiler($ioHash, 'Idle'); # set category to book following time, can be Delay, Fhem, Idle, Read, Send or Wait Profiler($ioHash, 'Idle'); # category to book time, Delay, Fhem, Idle, Read, Send or Wait
#Log3 $name, 3, "$name: _UnDef done"; #Log3 $name, 3, "$name: _UnDef done";
return; return;
} }
@ -716,15 +717,20 @@ sub UndefLDFn {
my $hash = shift; my $hash = shift;
my $arg = shift; my $arg = shift;
my $name = $hash->{NAME}; my $name = $hash->{NAME};
Log3 $name, 3, "$name: _UnDef is closing $name"; Log3 $name, 3, "$name: _UnDef is preparing $name for deletion";
UnregAtIODev($hash); UnregAtIODev($hash);
# device is already in the process of being deleted so we should not issue commandDelete inside _Close again # device is already in the process of being deleted so we should not issue commandDelete inside _Close again
DoClose($hash,1 ,1) if (IsOpen($hash)); # close, set Expect, clear Buffer, don't set state, don't delete yet # dont check isOpen, close even if closed and potentially on readyfn list
UpdateTimer($hash, \&Modbus::GetUpdate, 'stop'); DoClose($hash, {NODELETE => 1});
delete $hash->{PROTOCOL}; # just in case somebody keeps a pointer to our hash ... UpdateTimer($hash, \&Modbus::GetUpdate, 'stop');
RemoveInternalTimer ("scan:$name"); # scan timer for logical devices
# other timers are stopped in DoClose
delete $hash->{PROTOCOL}; # fix memory leak
delete $hash->{MODE}; delete $hash->{MODE};
delete $hash->{IODev}; delete $hash->{IODev};
delete $hash->{CHILDOF};
return; return;
} }
@ -741,12 +747,14 @@ sub AttrFn {
Log3 $name, 5, "$name: attr $cmd $aName" . (defined($aVal) ? ", $aVal" : ""); Log3 $name, 5, "$name: attr $cmd $aName" . (defined($aVal) ? ", $aVal" : "");
if ($aName eq 'disable' && $init_done) { # only after init_done, otherwise see NotifyFN if ($aName eq 'disable' && $init_done) { # only after init_done, otherwise see NotifyFN
# disable on a physical serial device # disable on a physical device
if ($cmd eq "set" && $aVal) { if ($cmd eq "set" && $aVal) {
Log3 $name, 3, "$name: attr disable set" . (IsOpen($hash) ? ", closing connection" : ""); Log3 $name, 3, "$name: attr disable set" . (IsOpen($hash) ? ", closing connection" : "");
# todo: call setstates here? would call DoClose, stop timers
DoClose($hash); # close, set Expect, clear Buffer, set state to disconnected DoClose($hash); # close, set Expect, clear Buffer, set state to disconnected
UpdateTimer($hash, \&Modbus::GetUpdate, 'stop'); UpdateTimer($hash, \&Modbus::GetUpdate, 'stop'); # even here for physical device?
} # other timers are stopped in DoClose
}
elsif ($cmd eq 'del' || ($cmd eq 'set' && !$aVal)) { elsif ($cmd eq 'del' || ($cmd eq 'set' && !$aVal)) {
Log3 $name, 3, "$name: attr disable removed"; Log3 $name, 3, "$name: attr disable removed";
DoOpen($hash) if (!AttrVal($name, 'closeAfterResponse', 0)); DoOpen($hash) if (!AttrVal($name, 'closeAfterResponse', 0));
@ -878,61 +886,17 @@ sub AttrLDFn {
if ($aName eq 'disable' && $init_done) { # if not init_done, nothing to be done here (see NotifyFN) if ($aName eq 'disable' && $init_done) { # if not init_done, nothing to be done here (see NotifyFN)
if ($cmd eq "set" && $aVal) { # disable set on a logical device (not physical serial here!) if ($cmd eq "set" && $aVal) { # disable set on a logical device (not physical serial here!)
SetLDInactive($hash); SetStates($hash, 'disabled'); # set state, close / stop timers
SetStates($hash, 'disabled');
} }
elsif ($cmd eq 'del' || ($cmd eq 'set' && !$aVal)) { # disable removed / cleared elsif ($cmd eq 'del' || ($cmd eq 'set' && !$aVal)) { # disable removed / cleared
Log3 $name, 3, "$name: attr disable removed"; Log3 $name, 3, "$name: attr disable removed";
SetLDActive($hash); SetStates($hash, 'enabled'); # set state, open / start update timer
SetStates($hash, 'enabled'); # don't check attr disable (not cleared yet) and set to active temporarily
} }
} }
return; return;
} }
######################################################
# set the logical device to inactive, close IO
# and stop timer
sub SetLDInactive {
my $hash = shift;
my $name = $hash->{NAME};
if ($hash->{TCPConn}) { # Modbus over TCP connection
Log3 $name, 3, "$name: device is beeing set to inactive / disabled" . (IsOpen($hash) ? ", closing TCP connection" : "");
DoClose($hash); # close, set Expect, clear Buffer, set state to disconnected
UpdateTimer($hash, \&Modbus::GetUpdate, 'stop');
}
else { # connection via serial io device
UnregAtIODev($hash); # unregister at physical device because logical device is disabled
}
UpdateTimer($hash, \&Modbus::GetUpdate, 'stop');
return;
}
######################################################
# activate the logical device, reopen, set timer
sub SetLDActive {
my $hash = shift;
my $name = $hash->{NAME};
if ($hash->{TCPConn}) { # Modbus over TCP connection
if (!IsOpen($hash)) {
DoOpen($hash) if !AttrVal($name, "closeAfterResponse", 0);
}
}
else {
my $ioHash = GetIOHash($hash); # get ioHash / check compatibility and set / register if necessary
Log3 $name, 3, "$name: " . ($ioHash ? "using $ioHash->{NAME}" : "no IODev") . " for communication";
}
if ($hash->{MODE} && $hash->{MODE} eq 'master') {
UpdateTimer($hash, \&Modbus::GetUpdate, 'start'); # set / change timer
}
return;
}
########################################################################### ###########################################################################
# called from get / set if $hash->{'.updateSetGet'} is set # called from get / set if $hash->{'.updateSetGet'} is set
# which is done in define and attr # which is done in define and attr
@ -1121,7 +1085,9 @@ sub SetLDFn {
my $fCode = GetFC($hash, {TYPE => $type, ADR => $adr, LEN => $len, OPERATION => 'write'}); my $fCode = GetFC($hash, {TYPE => $type, ADR => $adr, LEN => $len, OPERATION => 'write'});
my $ioHash = GetIOHash($hash); # ioHash has been checked in GetSetChecks above already my $ioHash = GetIOHash($hash); # ioHash has been checked in GetSetChecks above already
DoRequest($hash, {TYPE => $type, ADR => $adr, LEN => $len, OPERATION => 'write', VALUES => $packedVal, FORCE => !$async, DBGINFO => "set $setName"}); DoRequest($hash, {TYPE => $type, ADR => $adr, LEN => $len, OPERATION => 'write', VALUES => $packedVal, FORCE => !$async, DBGINFO => "set $setName"});
StartQueueTimer($hash, \&Modbus::ProcessRequestQueue, {delay => 0}); # call processRequestQueue at next possibility (others waiting?) # StartQueueTimer($hash, \&Modbus::ProcessRequestQueue, {delay => 0}); # call processRequestQueue at next possibility (others waiting?)
# DoRequest should call QueueRequest which calls StartQueueTimer without delay ...
if (!$async) { if (!$async) {
my $err = ReadAnswer($ioHash); my $err = ReadAnswer($ioHash);
return $err if ($err); return $err if ($err);
@ -1139,7 +1105,7 @@ sub SetLDFn {
######################################################################## ########################################################################
# SET command - handle predefined control sets fpr logical device # SET command - handle predefined control sets for logical device
sub ControlSet { sub ControlSet {
my $hash = shift; my $hash = shift;
my $setName = shift; my $setName = shift;
@ -1148,7 +1114,7 @@ sub ControlSet {
if ($setName eq 'interval') { if ($setName eq 'interval') {
return 'set interval is only allowed when Fhem is Modbus master' if ($hash->{MODE} ne 'master'); return 'set interval is only allowed when Fhem is Modbus master' if ($hash->{MODE} ne 'master');
if (!$setVal || $setVal !~ m{ \A [0-9.]+ (\.[0-9]+)? \z}xms ) { if (!defined($setVal) || $setVal !~ m{ \A [0-9.]+ (\.[0-9]+)? \z}xms ) {
Log3 $name, 3, "$name: set interval $setVal not valid"; Log3 $name, 3, "$name: set interval $setVal not valid";
Log3 $name, 3, "$name: continuing with $hash->{Interval} (sec)" if ($hash->{Interval}); Log3 $name, 3, "$name: continuing with $hash->{Interval} (sec)" if ($hash->{Interval});
return 'No valid Interval specified'; return 'No valid Interval specified';
@ -1186,14 +1152,12 @@ sub ControlSet {
} }
if ($setName eq 'active' && AttrVal($name, 'enableSetInactive', 1) ) { if ($setName eq 'active' && AttrVal($name, 'enableSetInactive', 1) ) {
return 'device is disabled' if (AttrVal($name, 'disable', 0)); return 'device is disabled' if (AttrVal($name, 'disable', 0));
SetStates($hash, 'active'); SetStates($hash, 'active'); # set state, open / start update timer
SetLDActive($hash);
return '0'; return '0';
} }
if ($setName eq 'inactive' && AttrVal($name, 'enableSetInactive', 1)) { if ($setName eq 'inactive' && AttrVal($name, 'enableSetInactive', 1)) {
return 'device is disabled' if (AttrVal($name, 'disable', 0)); return 'device is disabled' if (AttrVal($name, 'disable', 0));
SetStates($hash, 'inactive'); SetStates($hash, 'inactive'); # set state, close / stop timers
SetLDInactive($hash);
return '0'; return '0';
} }
if ($setName eq 'stop') { if ($setName eq 'stop') {
@ -1583,7 +1547,7 @@ sub DoOpen {
my $caller = FhemCaller(); my $caller = FhemCaller();
if ($hash->{DeviceName} eq 'none') { if ($hash->{DeviceName} eq 'none') {
Log3 $name, 5, "$name: open called from $caller, device is defined with none" if ($caller ne 'Ready'); Log3 $name, 5, "$name: open called from $caller, device is defined with none" if ($caller ne 'ReadyFn');
SetStates($hash, 'opened'); SetStates($hash, 'opened');
} }
elsif (!$hash->{TCPConn} && $hash->{TYPE} ne 'Modbus') { # only open physical devices or TCP elsif (!$hash->{TCPConn} && $hash->{TYPE} ne 'Modbus') { # only open physical devices or TCP
@ -1597,8 +1561,8 @@ sub DoOpen {
elsif ($hash->{TCPServer}) { elsif ($hash->{TCPServer}) {
# Modbus slave or relay over TCP connection -> open listening port # Modbus slave or relay over TCP connection -> open listening port
Log3 $name, 5, "$name: Open called for listening to a TCP connection"; Log3 $name, 5, "$name: Open called for listening to a TCP connection";
if ($arg_ref->{CLOSEFIRST} && IsOpen($hash)) { if ($arg_ref->{CLOSEFIRST}) {
DoClose($hash, 1); # close, set Expect, clear Buffer, don't set state DoClose($hash); # close and set state in case open fails
} }
my ($dest, $port) = split(/[:\s]+/, $hash->{DeviceName}); my ($dest, $port) = split(/[:\s]+/, $hash->{DeviceName});
my $ret = TcpServer_Open($hash, $port, $dest); my $ret = TcpServer_Open($hash, $port, $dest);
@ -1608,7 +1572,7 @@ sub DoOpen {
SetStates($hash, 'opened'); SetStates($hash, 'opened');
} }
} }
else { # normal case, physical device or TCP else { # normal case, physical device or TCP
my $timeOt = AttrVal($name, 'openTimeout', 3); my $timeOt = AttrVal($name, 'openTimeout', 3);
my $delay2 = AttrVal($name, 'nextOpenDelay2', 1); my $delay2 = AttrVal($name, 'nextOpenDelay2', 1);
my $nextOp = $hash->{NEXT_OPEN} // 0; my $nextOp = $hash->{NEXT_OPEN} // 0;
@ -1622,11 +1586,12 @@ sub DoOpen {
Log3 $name, 3, "$name: open - stop waiting for callback and reset the BUSY flag."; Log3 $name, 3, "$name: open - stop waiting for callback and reset the BUSY flag.";
$hash->{BUSY_OPENDEV} = 0; $hash->{BUSY_OPENDEV} = 0;
} }
if ($arg_ref->{CLOSEFIRST} && IsOpen($hash)) { # close first and already open if ($arg_ref->{CLOSEFIRST}) { # close first and already open
Log3 $name, 5, "$name: Open called for DevIo connection - closing first"; Log3 $name, 5, "$name: Open called for DevIo connection - closing first";
DoClose($hash, 1); # close, set Expect, clear Buffer, don't set state to disconnected DoClose($hash); # close and set state in case open fails
delete $hash->{DevIoJustClosed}; # allow direct opening without further delay delete $hash->{DevIoJustClosed}; # allow direct opening without further delay
} elsif ($nextOp && ($nextOp > $now)) { }
elsif ($nextOp && ($nextOp > $now)) {
Log3 $name, 5, "$name: open ignored because DevIo has set NEXT_OPEN to $nextOp / " . FmtTimeMs($nextOp) . Log3 $name, 5, "$name: open ignored because DevIo has set NEXT_OPEN to $nextOp / " . FmtTimeMs($nextOp) .
" and now is $now / " . FmtTimeMs($now); " and now is $now / " . FmtTimeMs($now);
return; return;
@ -1655,7 +1620,10 @@ sub DoOpen {
} }
Profiler($hash, 'Idle'); # set category to book following time, can be Delay, Fhem, Idle, Read, Send or Wait Profiler($hash, 'Idle'); # set category to book following time, can be Delay, Fhem, Idle, Read, Send or Wait
ResetExpect($hash); ResetExpect($hash);
StartQueueTimer($hash, \&Modbus::ProcessRequestQueue, {delay => 0.5, silent => 0}); # process queue in case something is waiting but delay so open can call back
# don't start queue timer until connection is actually open -> OpenCB
# StartQueueTimer($hash, \&Modbus::ProcessRequestQueue, {delay => 0.5, silent => 0}); # process queue in case something is waiting but delay so open can call back
DropBuffer($hash); DropBuffer($hash);
delete $hash->{TIMEOUT}; delete $hash->{TIMEOUT};
return; return;
@ -1674,7 +1642,10 @@ sub OpenCB {
if (IsOpen($hash)) { if (IsOpen($hash)) {
delete $hash->{TIMEOUTS} ; delete $hash->{TIMEOUTS} ;
UpdateTimer($hash, \&Modbus::GetUpdate, 'start'); # set / change timer UpdateTimer($hash, \&Modbus::GetUpdate, 'start'); # set / change timer
} }
# stop queue-Timer while disconnected and start it again with delay 0 here
StartQueueTimer($hash, \&Modbus::ProcessRequestQueue, {delay => 0, silent => 0});
return; return;
} }
@ -1683,8 +1654,11 @@ sub OpenCB {
# close connection # close connection
# $hash is physical or both (connection over TCP) # $hash is physical or both (connection over TCP)
sub DoClose { sub DoClose {
my ($hash, $noState, $noDelete) = @_; my $hash = shift;
my $name = $hash->{NAME}; my $arg_ref = shift // {};
my $noDelete = $arg_ref->{NODELETE} // 0;
my $keepQueue = $arg_ref->{KEEPQUEUE} // 0;
my $name = $hash->{NAME};
if (!$hash->{TCPConn} && $hash->{TYPE} ne 'Modbus') { if (!$hash->{TCPConn} && $hash->{TYPE} ne 'Modbus') {
Log3 $name, 3, "$name: close called from " . FhemCaller() . Log3 $name, 3, "$name: close called from " . FhemCaller() .
@ -1693,19 +1667,31 @@ sub DoClose {
} }
Log3 $name, 5, "$name: Close called from " . FhemCaller() . Log3 $name, 5, "$name: Close called from " . FhemCaller() .
($noState || $noDelete ? ' with ' : '') . ($noState ? 'noState' : '') . # set state? ($keepQueue || $noDelete ? ' with ' : '') . ($keepQueue ? 'keepQueue' : '') .
($noState && $noDelete ? ' and ' : '') . ($noDelete ? 'noDelete' : ''); # command delete on connection device? ($keepQueue && $noDelete ? ' and ' : '') . ($noDelete ? 'noDelete' : '');
delete $hash->{LASTOPEN}; # reset so next open will actually call OpenDev delete $hash->{LASTOPEN}; # reset so next open will actually call OpenDev
if ($hash->{TCPChild} && IsOpen($hash)) { # this is a slave or relay connection hash if ($hash->{TCPChild}) { # this is a slave or relay connection hash
Log3 $name, 4, "$name: Close TCP server listening connection and delete hash"; Log3 $name, 4, "$name: Close TCP server listening connection and delete hash";
TcpServer_Close($hash); TcpServer_Close($hash);
RemoveInternalTimer ("stimeout:$name"); RemoveInternalTimer ("stimeout:$name");
CommandDelete(undef, $name) if (!$noDelete); if ($hash->{CHILDOF}){
if ($hash->{CHILDOF} && $hash->{CHILDOF}{LASTCONN} && $hash->{CHILDOF}{LASTCONN} eq $hash->{NAME}) { my $parent = $hash->{CHILDOF};
Log3 $name, 5, "$name: Close is removing lastconn from parent device $hash->{CHILDOF}{NAME}"; delete $parent->{CONNECTHASH}{$name};
delete $hash->{CHILDOF}{LASTCONN} if ($parent->{LASTCONN} && $parent->{LASTCONN} eq $hash->{NAME}) {
Log3 $name, 5, "$name: Close is removing lastconn from parent device $parent->{NAME}";
delete $parent->{LASTCONN};
}
} }
delete $hash->{CHILDOF}; # fix memory leak
delete $hash->{IODEV};
delete $hash->{REQUEST};
delete $hash->{RESPONSE};
delete $hash->{FRAME};
delete $hash->{READ};
delete $hash->{REMEMBER};
CommandDelete(undef, $name) if (!$noDelete); # delete tcp connection device unless called from undefFn which wants to delete later
return; # this hash is removed from %defs, attr ...
} }
elsif ($hash->{TCPServer} && IsOpen($hash)) { # this is a slave or relay listening device elsif ($hash->{TCPServer} && IsOpen($hash)) { # this is a slave or relay listening device
Log3 $name, 4, "$name: Close TCP server socket, now look for active connections"; Log3 $name, 4, "$name: Close TCP server socket, now look for active connections";
@ -1713,7 +1699,7 @@ sub DoClose {
foreach my $conn (keys %{$hash->{CONNECTHASH}}) { foreach my $conn (keys %{$hash->{CONNECTHASH}}) {
my $chash = $hash->{CONNECTHASH}{$conn}; my $chash = $hash->{CONNECTHASH}{$conn};
TcpServer_Close($chash); TcpServer_Close($chash);
Log3 $chash->{NAME}, 4, "$chash->{NAME}: Close TCP server connection of parent $name and delete hash"; Log3 $chash->{NAME}, 4, "$chash->{NAME}: Close TCP server connection of parent $name";
RemoveInternalTimer ("stimeout:$chash->{NAME}"); RemoveInternalTimer ("stimeout:$chash->{NAME}");
CommandDelete(undef, $chash->{NAME}) if (!$noDelete); CommandDelete(undef, $chash->{NAME}) if (!$noDelete);
} }
@ -1728,14 +1714,21 @@ sub DoClose {
# close even if it was not open yet but on ready list (need to remove entry from readylist) # close even if it was not open yet but on ready list (need to remove entry from readylist)
DevIo_CloseDev($hash); DevIo_CloseDev($hash);
} }
SetStates($hash, 'disconnected') if (!$noState); SetStates($hash, 'disconnected');
ResetExpect($hash); ResetExpect($hash);
DropBuffer($hash); DropBuffer($hash);
Profiler($hash, 'Idle'); # set category to book following time, can be Delay, Fhem, Idle, Read, Send or Wait Profiler($hash, 'Idle'); # set category to book following time, can be Delay, Fhem, Idle, Read, Send or Wait
StopQueueTimer($hash, {silent => 1}); delete $hash->{IODev};
if($keepQueue) {
my $qlen = ($hash->{QUEUE} ? scalar(@{$hash->{QUEUE}}) : 0);
Log3 $name, 4, "$name: DoClose keeps queue with len $qlen";
}
else {
StopQueueTimer($hash, {silent => 1});
delete $hash->{QUEUE};
}
RemoveInternalTimer ("timeout:$name"); # remove ResponseTimeout timer when connection is closed RemoveInternalTimer ("timeout:$name"); # remove ResponseTimeout timer when connection is closed
delete $hash->{nextTimeout}; delete $hash->{nextTimeout};
delete $hash->{QUEUE};
return; return;
} }
@ -1750,8 +1743,7 @@ sub ReadyFn {
if($hash->{STATE} eq 'disconnected') { if($hash->{STATE} eq 'disconnected') {
if (IsDisabled($name)) { if (IsDisabled($name)) {
Log3 $name, 3, "$name: ready called but $name is disabled - don't try to reconnect - call DoClose"; Log3 $name, 3, "$name: ready called but $name is disabled - don't try to reconnect - call DoClose";
DoClose($hash, 1); # close, set Expect, clear Buffer, don't set state to disconnected (must have already been done) DoClose($hash); # state sollte schon disabled sein, macht aber nichts.
UpdateTimer($hash, \&Modbus::GetUpdate, 'stop');
return; return;
} }
DoOpen($hash, {READY => 1}); # reopen, dont call DevIoClose before reopening DoOpen($hash, {READY => 1}); # reopen, dont call DevIoClose before reopening
@ -1781,7 +1773,7 @@ sub HandleServerConnection {
$chash->{MODBUSID} = $hash->{MODBUSID}; $chash->{MODBUSID} = $hash->{MODBUSID};
$chash->{PROTOCOL} = $hash->{PROTOCOL}; $chash->{PROTOCOL} = $hash->{PROTOCOL};
$chash->{MODE} = $hash->{MODE}; $chash->{MODE} = $hash->{MODE};
$chash->{RELAY} = $hash->{RELAY}; $chash->{RELAY} = $hash->{RELAY}; # name of relay master device if this is a relay
$chash->{CHILDOF} = $hash; # point to parent device to get object definitions from there $chash->{CHILDOF} = $hash; # point to parent device to get object definitions from there
$chash->{IODev} = $chash; $chash->{IODev} = $chash;
$chash->{TCPConn} = 1; $chash->{TCPConn} = 1;
@ -1794,14 +1786,13 @@ sub HandleServerConnection {
$attr{$chash->{NAME}}{verbose} = $attr{$name}{verbose}; # copy verbose attr from parent $attr{$chash->{NAME}}{verbose} = $attr{$name}{verbose}; # copy verbose attr from parent
$hash->{LASTCONN} = $chash->{NAME}; # point from parent device to last connection device $hash->{LASTCONN} = $chash->{NAME}; # point from parent device to last connection device
$hash->{CONNECTHASH}{$chash->{NAME}} = $chash; $hash->{CONNECTHASH}{$chash->{NAME}} = $chash;
weaken $hash->{CONNECTHASH}{$chash->{NAME}};
my $room = AttrVal($name, 'connectionsRoom', 'Connections'); my $room = AttrVal($name, 'connectionsRoom', 'Connections');
if ($room !~ '[Nn]one') { if ($room !~ '[Nn]one') {
CommandAttr(undef, "$chash->{NAME} room $room"); # set room CommandAttr(undef, "$chash->{NAME} room $room"); # set room
} }
my $to = gettimeofday() + DevInfo($hash, 'timing', 'serverTimeout', 120); my $to = gettimeofday() + DevInfo($hash, 'timing', 'serverTimeout', 120);
InternalTimer($to, \&Modbus::ServerTimeout, "stimeout:$chash->{NAME}", 0); InternalTimer($to, \&Modbus::ServerTimeout, "stimeout:$chash->{NAME}", 0);
return; return;
} }
@ -1860,16 +1851,19 @@ sub ReadFn {
return; return;
} }
# TCP client device connection device hash # TCP client device connection device hash
Profiler($hash, 'Read'); # read from TCP socket Profiler($hash, 'Read'); # read from TCP socket
$ret = sysread($hash->{CD}, $buf, 256) if ($hash->{CD}); $ret = sysread($hash->{CD}, $buf, 256) if ($hash->{CD});
if(!defined($ret) || $ret <= 0) { # connection closed if(!defined($ret) || $ret <= 0) { # connection closed
Log3 $name, 3, "$name: read from TCP server connection got null -> closing"; Log3 $name, 3, "$name: read from TCP server connection got null -> closing";
CommandDelete(undef, $name); CommandDelete(undef, $name);
return; return;
} }
RemoveInternalTimer ("stimeout:$name");
my $to = $now + DevInfo($hash, 'timing', 'serverTimeout', 120); my $to = $now + DevInfo($hash, 'timing', 'serverTimeout', 120);
InternalTimer($to, \&Modbus::ServerTimeout, "stimeout:$name", 0); my $tA = DevInfo($hash, 'timing', 'serverTimeoutAbs', 0);
if (!$tA) {
RemoveInternalTimer ("stimeout:$name");
InternalTimer($to, \&Modbus::ServerTimeout, "stimeout:$name", 0);
}
} }
else { else {
Profiler($hash, 'Read'); Profiler($hash, 'Read');
@ -1897,6 +1891,26 @@ sub ReadFn {
} }
my $frame = $hash->{FRAME}; # is set after calling ParseFrameStart my $frame = $hash->{FRAME}; # is set after calling ParseFrameStart
# only for testing - remove later # todo: remove
my $attrsName = $name;
if ($hash->{CHILDOF}) {
$attrsName = $hash->{CHILDOF}{NAME};
}
my $requestDelay = AttrVal ($attrsName, 'requestDelay', 0);
#Log3 $name, 3, "$name: requestDelay is $requestDelay";
if ($requestDelay) {
if ($hash->{LastRequest}) {
if ($hash->{LastRequest} + $requestDelay > $now) {
Log3 $name, 3, "$name: requestDelay causes request to be ignored";
DropFrame($hash);
return;
}
}
$hash->{LastRequest} = $now;
}
# EXPECT exists on io dev. Special case for relays: # EXPECT exists on io dev. Special case for relays:
# there are two io devs. receiving side and forwarding side. # there are two io devs. receiving side and forwarding side.
# read can be called when a new request comes in on receiving side (mode relay) # read can be called when a new request comes in on receiving side (mode relay)
@ -1948,7 +1962,7 @@ sub ReadFn {
sub ReadAnswer { sub ReadAnswer {
my $hash = shift; # called with physical io device hash my $hash = shift; # called with physical io device hash
my $name = $hash->{NAME}; my $name = $hash->{NAME};
my $logHash = $hash->{REQUEST}{MASTERHASH}; # logical device that sent last request, stored by ProcessRequestQueue my $logHash = $hash->{REQUEST}{MASTERHASH}; # logical device that sent last request, stored by ProcessRequestQueue, checked in loop ...
my $timeout = DevInfo($logHash, 'timing', 'timeout', 2); my $timeout = DevInfo($logHash, 'timing', 'timeout', 2);
my $now = gettimeofday(); my $now = gettimeofday();
my $timeRest; my $timeRest;
@ -1976,6 +1990,11 @@ sub ReadAnswer {
if ($timeout <= 0 || ($hash->{DeviceName} eq 'none' && !$hash->{TestInput})) { if ($timeout <= 0 || ($hash->{DeviceName} eq 'none' && !$hash->{TestInput})) {
last READLOOP; # Timeout - will be logged after the loop last READLOOP; # Timeout - will be logged after the loop
} }
if (!$hash->{REQUEST}{MASTERHASH}) {
Log3 $name, 5, "$name: ReadAnswer misses MASTERHASH and returns";
$msg = 'ReadAnswer called but MASTERHASH disappeared';
last READLOOP;
}
if ($hash->{DeviceName} eq 'none') { # simulate receiving if ($hash->{DeviceName} eq 'none') { # simulate receiving
$buf = $hash->{TestInput}; $buf = $hash->{TestInput};
delete $hash->{TestInput}; delete $hash->{TestInput};
@ -1996,6 +2015,7 @@ sub ReadAnswer {
if ($nfound < 0) { if ($nfound < 0) {
next if ($! == EAGAIN() || $! == EINTR() || $! == 0); next if ($! == EAGAIN() || $! == EINTR() || $! == 0);
$msg = 'Error in ReadAnswer: $!'; $msg = 'Error in ReadAnswer: $!';
Log3 $name, 3, "$name: ReadAnswer sets device to disconnected";
DevIo_Disconnected($hash); # close, set state but put back on readyfnlist for reopening DevIo_Disconnected($hash); # close, set state but put back on readyfnlist for reopening
last READLOOP; last READLOOP;
} }
@ -2045,6 +2065,7 @@ sub ReadAnswer {
DropFrame($hash); # drop $hash->{FRAME} and the relevant part of $hash->{READ}{BUFFER} DropFrame($hash); # drop $hash->{FRAME} and the relevant part of $hash->{READ}{BUFFER}
delete $hash->{nextTimeout}; delete $hash->{nextTimeout};
delete $hash->{REQUEST}; delete $hash->{REQUEST};
# todo: normal queue delay when closeAfterResponse 2?
StartQueueTimer($hash, \&Modbus::ProcessRequestQueue, {delay => 0}); # call processRequestQueue at next possibility if appropriate StartQueueTimer($hash, \&Modbus::ProcessRequestQueue, {delay => 0}); # call processRequestQueue at next possibility if appropriate
return $msg; return $msg;
} }
@ -2210,8 +2231,15 @@ sub HandleResponse {
$response->{ADR} = $request->{ADR}; # prefill so we don't need $request in ParseResponse and it gets shorter $response->{ADR} = $request->{ADR}; # prefill so we don't need $request in ParseResponse and it gets shorter
$response->{LEN} = $request->{LEN}; $response->{LEN} = $request->{LEN};
$response->{OPERATION} = $request->{OPERATION}; # for later call to ParseDataString $response->{OPERATION} = $request->{OPERATION}; # for later call to ParseDataString
$response->{MASTERHASH} = $masterHash if ($masterHash);
$response->{RELAYHASH} = $request->{RELAYHASH} if ($request->{RELAYHASH}); # not $relayHash! if ($masterHash) {
$response->{MASTERHASH} = $masterHash;
weaken $response->{MASTERHASH};
}
if ($request->{RELAYHASH}) { # not $relayHash!
$response->{RELAYHASH} = $request->{RELAYHASH};
weaken $response->{RELAYHASH};
}
} # if no request known, we will skip most of the part below } # if no request known, we will skip most of the part below
# parse response and fill response hash # parse response and fill response hash
@ -2244,10 +2272,6 @@ sub HandleResponse {
RelayResponse($hash, $request, $response) if ($relayHash && $request); # add to {ERROR} if relay device is unavailable RelayResponse($hash, $request, $response) if ($relayHash && $request); # add to {ERROR} if relay device is unavailable
} }
if ($hash->{MODE} eq 'master' && AttrVal($name, 'closeAfterResponse', 0) && ($hash->{QUEUE} ? scalar(@{$hash->{QUEUE}}) : 0) == 0) {
Log3 $name, 4, "$name: HandleResponse will close because closeAfterResponse is set and queue is empty";
DoClose($hash)
}
LogFrame($hash, ($hash->{FRAME}{ERROR} ? "HandleResponse error" : 'HandleResponse done'), 4); LogFrame($hash, ($hash->{FRAME}{ERROR} ? "HandleResponse error" : 'HandleResponse done'), 4);
Statistics($hash, 'Timeouts', 0); # damit bei Bedarf das Reading gesetzt wird Statistics($hash, 'Timeouts', 0); # damit bei Bedarf das Reading gesetzt wird
ResetExpect($hash); # for master back to 'idle', otherwise back to 'request' ResetExpect($hash); # for master back to 'idle', otherwise back to 'request'
@ -2255,6 +2279,22 @@ sub HandleResponse {
delete $hash->{REQUEST}; delete $hash->{REQUEST};
delete $hash->{RESPONSE}; delete $hash->{RESPONSE};
RemoveInternalTimer ("timeout:$name"); # remove ResponseTimeout timer now that Response has arrived RemoveInternalTimer ("timeout:$name"); # remove ResponseTimeout timer now that Response has arrived
if ($hash->{MODE} eq 'master') {
if (AttrVal($name, 'closeAfterResponse', 0) && ($hash->{QUEUE} ? scalar(@{$hash->{QUEUE}}) : 0) == 0) {
Log3 $name, 4, "$name: HandleResponse will close because closeAfterResponse is set and queue is empty";
DoClose($hash);
return 1;
}
elsif (AttrVal($name, 'closeAfterResponse', 0) == 2) {
Log3 $name, 4, "$name: HandleResponse will close because closeAfterResponse is 2";
DoClose($hash, {KEEPQUEUE => 1});
StopQueueTimer($hash); # restart with full queue delay
StartQueueTimer($hash, \&Modbus::ProcessRequestQueue);
return 1;
}
}
StartQueueTimer($hash, \&Modbus::ProcessRequestQueue, {delay => 0}); # set timer to call processRequestQueue asap StartQueueTimer($hash, \&Modbus::ProcessRequestQueue, {delay => 0}); # set timer to call processRequestQueue asap
return 1; # error or not, parsing is done. return 1; # error or not, parsing is done.
} }
@ -2509,7 +2549,7 @@ sub WriteObject {
next OBJLOOP; next OBJLOOP;
} }
if (!TryCall($hash, 'ModbusReadingsFn', $reading, $val)) { if (!TryCall($hash, 'ModbusReadingsFn', $reading, $val)) {
Log3 $name, 4, "$name: ParseDataString assigns value $val to reading $rname of device $device"; Log3 $name, 4, "$name: WriteObject assigns value $val to reading $rname of device $device";
if ($dev eq $hash) { if ($dev eq $hash) {
readingsBulkUpdate($dev, $rname, $val); # assign value to one of this devices readings readingsBulkUpdate($dev, $rname, $val); # assign value to one of this devices readings
} else { } else {
@ -2524,6 +2564,7 @@ sub WriteObject {
##################################################### #####################################################
# split data part in a response or write request # split data part in a response or write request
# into objects that later can be assigned to readings # into objects that later can be assigned to readings
# only called from ParseDataString
sub SplitDataString { sub SplitDataString {
my $hash = shift; my $hash = shift;
my $transPtr = shift; # $transPtr can be response (mode master) or request (mode slave and write request) my $transPtr = shift; # $transPtr can be response (mode master) or request (mode slave and write request)
@ -2618,6 +2659,7 @@ sub CreateParseInfoCache {
'rmapDefault' => ObjInfo($hash, $objCombi, 'rmapDefault'), 'rmapDefault' => ObjInfo($hash, $objCombi, 'rmapDefault'),
'format' => ObjInfo($hash, $objCombi, 'format'), 'format' => ObjInfo($hash, $objCombi, 'format'),
}; };
return; return;
} }
@ -2667,7 +2709,7 @@ sub CreateDataObjects {
my $val = $val[0]; my $val = $val[0];
next OBJLOOP if ($pi->{'ignoreExpr'} && EvalExpr($hash, # ignore exp results true -> skip to next object next OBJLOOP if ($pi->{'ignoreExpr'} && EvalExpr($hash, # ignore exp results true -> skip to next object
{expr => $pi->{'ignoreExpr'}, val => $val,, '@val' => \@val, {expr => $pi->{'ignoreExpr'}, val => $val, '@val' => \@val,
nullIfNoExp => 1, action => "ignoreExpr for $obj->{reading}"})); nullIfNoExp => 1, action => "ignoreExpr for $obj->{reading}"}));
if ($transPtr->{OPERATION} && $transPtr->{OPERATION} =~ /^scan/) { if ($transPtr->{OPERATION} && $transPtr->{OPERATION} =~ /^scan/) {
@ -2698,10 +2740,9 @@ sub CreateDataObjects {
} }
################################################# ################################################################################
# Parse holding / input register / coil Data # Parse holding / input register / coil Data
# called from ParseResponse which is only called from HandleResponse # called from HandleResponse or from HandleRequest (for write requests as slave)
# or from HandleRequest (for write requests as slave)
# with logical device hash, data string and the object type/adr to start with # with logical device hash, data string and the object type/adr to start with
sub ParseDataString { sub ParseDataString {
my $hash = shift; my $hash = shift;
@ -2793,6 +2834,7 @@ sub HandleRequest {
} }
elsif ($hash->{MODE} eq 'relay') { elsif ($hash->{MODE} eq 'relay') {
$request->{RELAYHASH} = $logHash; # remember who to pass the response to $request->{RELAYHASH} = $logHash; # remember who to pass the response to
weaken $request->{RELAYHASH};
RelayRequest($hash, $request, $frame); # even if unspported fCode ... RelayRequest($hash, $request, $frame); # even if unspported fCode ...
$hash->{EXPECT} = 'request'; # just to be safe, should already be request $hash->{EXPECT} = 'request'; # just to be safe, should already be request
} }
@ -2963,6 +3005,7 @@ sub GetRelayIO {
return; return;
} }
$relayHash->{MASTERHASH} = $masterHash; $relayHash->{MASTERHASH} = $masterHash;
weaken $relayHash->{MASTERHASH};
$relayHash->{RELID} = $masterHash->{MODBUSID}; $relayHash->{RELID} = $masterHash->{MODBUSID};
Log3 $name, 5, "$name: GetRelayIO found $masterIOHash->{NAME} as Modbus relay forward io device for $masterHash->{NAME} with id $masterHash->{MODBUSID}"; Log3 $name, 5, "$name: GetRelayIO found $masterIOHash->{NAME} as Modbus relay forward io device for $masterHash->{NAME} with id $masterHash->{MODBUSID}";
#Log3 $name, 5, "$name: GetRelayIO set RELID of $relayHash to $relayHash->{RELID}"; #Log3 $name, 5, "$name: GetRelayIO set RELID of $relayHash to $relayHash->{RELID}";
@ -3011,7 +3054,9 @@ sub RelayRequest {
} }
my %fRequest = %{$request}; # create a copy to modify and forward my %fRequest = %{$request}; # create a copy to modify and forward
$fRequest{MASTERHASH} = $masterHash; $fRequest{MASTERHASH} = $masterHash;
weaken $fRequest{MASTERHASH};
LogFrame($hash, "RelayRequest via $reIOHash->{NAME}, Proto $reIOHash->{PROTOCOL} with id $id", 4); LogFrame($hash, "RelayRequest via $reIOHash->{NAME}, Proto $reIOHash->{PROTOCOL} with id $id", 4);
if ($reIOHash->{PROTOCOL} eq 'TCP') { # forward as Modbus TCP? if ($reIOHash->{PROTOCOL} eq 'TCP') { # forward as Modbus TCP?
my $tid = int(rand(255)); my $tid = int(rand(255));
@ -3047,7 +3092,7 @@ sub RelayResponse {
my $relayHash = $response->{RELAYHASH}; # hash of logical relay device that got the first request my $relayHash = $response->{RELAYHASH}; # hash of logical relay device that got the first request
my $ioHash = GetIOHash($relayHash); # the ioHash that received the original request my $ioHash = GetIOHash($relayHash); # the ioHash that received the original request
if (!$ioHash) { if (!$ioHash || !$relayHash) {
Log3 $name, 4, "$name: RelayResponse failed because slave (=server) side io device disappeared"; Log3 $name, 4, "$name: RelayResponse failed because slave (=server) side io device disappeared";
return; return;
} }
@ -3111,7 +3156,7 @@ sub CreateResponse {
$response->{VALUES} = $serverId; $response->{VALUES} = $serverId;
Log3 $name, 3, "$name: server id requested, send $serverId"; Log3 $name, 3, "$name: server id requested, send $serverId";
} }
Log3 $name, 5, "$name: CreateResponse calls PackFrame to prepare response pdu"; Log3 $name, 5, "$name: CreateResponse calls PackFrame to prepare response pdu";
$response->{FCODE} += 128 if ($response->{ERRCODE}); $response->{FCODE} += 128 if ($response->{ERRCODE});
@ -3193,6 +3238,7 @@ sub DoRequest {
$request->{MASTERHASH} = $hash; # logical device in charge $request->{MASTERHASH} = $hash; # logical device in charge
$request->{TID} = int(rand(255)) if ($hash->{PROTOCOL} eq 'TCP'); # transaction id for Modbus TCP $request->{TID} = int(rand(255)) if ($hash->{PROTOCOL} eq 'TCP'); # transaction id for Modbus TCP
$request->{FCODE} = GetFC($hash, $request); $request->{FCODE} = GetFC($hash, $request);
weaken $request->{MASTERHASH};
return if (!$request->{FCODE}); return if (!$request->{FCODE});
# check if defined unpack code matches a corresponding len and log warning if appropriate # check if defined unpack code matches a corresponding len and log warning if appropriate
@ -3267,7 +3313,9 @@ sub QueueRequest {
return; return;
} }
readingsSingleUpdate($hash, 'QueueLength', ($hash->{QUEUE} ? scalar(@{$hash->{QUEUE}}) : 0), 1) if (AttrVal($name, 'enableQueueLengthReading', 0)); readingsSingleUpdate($hash, 'QueueLength', ($hash->{QUEUE} ? scalar(@{$hash->{QUEUE}}) : 0), 1) if (AttrVal($name, 'enableQueueLengthReading', 0));
StartQueueTimer($hash, \&Modbus::ProcessRequestQueue, {delay => 0}); # process asap, after delays are over
StartQueueTimer($hash, \&Modbus::ProcessRequestQueue, {delay => 0}); # try to open if closed
# process asap, after delays are over
return; return;
} }
@ -4189,43 +4237,64 @@ sub CountTimeouts {
################################################################# #################################################################
# set state Reading and STATE internal # set state Reading and STATE internal
# call instead of setting STATE directly and when inactive / disconnected # call instead of setting STATE directly and when inactive / disconnected
# when called with
# opened - set to disabled if attr disable is set (after attr IODev, disabled would not be set after successful open)
# set to inactive if state reading is inactive
# otherwise set to opened
# disconnected - set to disabled if attr disable is set (when connection is lost or after define)
# set to inactive if state reading is already inactive
# otherwise set to disconnected
# inactive - set to disabled if attr disable is set (after set inactive)
# otherwise set to inactive
# active - set to disabled if attr disable is set (after set active)
# otherwise set to active temporarily
# after open state will be set again
# disabled - set to disabled (while attr disable is set)
# enabled - set to active temporarily (when attr disable is removed)
# after open state will be set again
sub SetStates { sub SetStates {
my $hash = shift; my $hash = shift;
my $state = shift; my $setState = shift;
my $name = $hash->{NAME}; my $name = $hash->{NAME};
my $newState = $state; my $oldState = ReadingsVal($name, 'state', '');
my $disabled = AttrVal($name, 'disable', 0);
my $newState = $setState;
Log3 $name, 5, "$name: SetStates called from " . FhemCaller() . " with $setState";
if ($setState eq 'disabled') {
#Log3 $name, 5, "$name: SetState called from " . FhemCaller() . " with $state, current state reading is " . ReadingsVal($name, 'state', ''); }
if ($state ne 'disabled') { # for disabled nothing else matters elsif ($setState eq 'enabled') { # attr disabled is not cleared yet here
if ($state eq 'enabled') { $newState = 'active'; # enabled (disable removed) becomes active
$newState = 'active'; # enabled (disable removed) becomes active }
} elsif ($state ne 'active') { elsif ($setState eq 'inactive') {
if (AttrVal($name, 'disable', 0)) { # otherweise check disable attr first $newState = 'disabled' if ($disabled);
$newState = 'disabled'; }
} elsif (ReadingsVal($name, 'state', '') eq 'inactive') { # and then check if inactive elsif ($setState eq 'active') {
$newState = 'inactive'; $newState = 'disabled' if ($disabled);
} }
elsif ($setState eq 'opened') {
}
elsif ($setState eq 'disconnected') {
$newState = 'inactive' if ($oldState eq 'inactive');
$newState = 'disabled' if ($disabled);
}
else {
Log3 $name, 5, "$name: SetState got unknown parameter $setState";
return;
}
if ($newState =~ /inactive|disabled/) {
if ($hash->{TCPConn}) { # Modbus over TCP connection
DoClose($hash); # close, set Expect, clear Buffer, set state to disconnected
UpdateTimer($hash, \&Modbus::GetUpdate, 'stop');
# other timers are stopped in DoClose
}
else { # connection via serial io device
UnregAtIODev($hash); # unregister at physical device because logical device is disabled
}
UpdateTimer($hash, \&Modbus::GetUpdate, 'stop');
}
elsif ($newState eq 'active') {
if ($hash->{TCPConn} && !IsOpen($hash)) { # closed Modbus over TCP connection
DoOpen($hash) if !AttrVal($name, "closeAfterResponse", 0);
}
else {
my $ioHash = GetIOHash($hash); # get ioHash / check compatibility and set / register if necessary
Log3 $name, 3, "$name: " . ($ioHash ? "using $ioHash->{NAME}" : "no IODev") . " for communication";
}
if ($hash->{MODE} && $hash->{MODE} eq 'master') {
UpdateTimer($hash, \&Modbus::GetUpdate, 'start'); # set / change timer
} }
} }
Log3 $name, 5, "$name: SetState called from " . FhemCaller() . " with $state sets state and STATE to $newState";
Log3 $name, 5, "$name: SetState sets state and STATE from $oldState to $newState";
$hash->{STATE} = $newState; $hash->{STATE} = $newState;
return if ($newState eq ReadingsVal($name, 'state', '')); return if ($newState eq ReadingsVal($name, 'state', ''));
readingsSingleUpdate($hash, 'state', $newState, 1); readingsSingleUpdate($hash, 'state', $newState, 1);
@ -4290,7 +4359,7 @@ sub ResponseTimeout {
if ($request && $relayHash) { # create an error response through the relay if ($request && $relayHash) { # create an error response through the relay
my $origRequest = $relayHash->{REQUEST}; my $origRequest = $relayHash->{REQUEST};
if (!$origRequest->{MODBUSID}) { if (!$origRequest->{MODBUSID}) {
Log3 $name, 4, "$name: relaying error response back failed because original request is missing"; Log3 $name, 4, "$name: relaying error response back failed because original request is missing. Maybe master has already closed connection to relay";
} }
else { else {
# adjust Modbus ID for back communication # adjust Modbus ID for back communication
@ -4300,6 +4369,7 @@ sub ResponseTimeout {
($request->{TID} ? ", tid $request->{TID}" : ''); ($request->{TID} ? ", tid $request->{TID}" : '');
my $reIoHash = GetIOHash($relayHash); # the physical hash of the relay that received the original request my $reIoHash = GetIOHash($relayHash); # the physical hash of the relay that received the original request
if (!$reIoHash) { if (!$reIoHash) {
Log3 $name, $logLvl, "$name: sending timout response back failed because relay slave (=server) side io device disappeared"; Log3 $name, $logLvl, "$name: sending timout response back failed because relay slave (=server) side io device disappeared";
} }
@ -4382,7 +4452,10 @@ sub CheckDisable {
my $msg; my $msg;
#Log3 $name, 5, "$name: CheckDisable called from " . FhemCaller(); #Log3 $name, 5, "$name: CheckDisable called from " . FhemCaller();
if ($hash->{TYPE} eq 'Modbus' || $hash->{TCPConn}) { # physical hash if (!$hash) {
$msg = 'device is unavailable / hash is undef';
}
elsif ($hash->{TYPE} eq 'Modbus' || $hash->{TCPConn}) { # physical hash
if (IsDisabled($name)) { if (IsDisabled($name)) {
$msg = 'device is disabled'; $msg = 'device is disabled';
} }
@ -4405,7 +4478,6 @@ sub CheckDisable {
################################################################ ################################################################
# set the $hash->{IODev} pointer to the physical io device # set the $hash->{IODev} pointer to the physical io device
# and register there # and register there
#
# check the name passed or the IODev attr or search for device # check the name passed or the IODev attr or search for device
# #
# called from GetIOHash with the logical hash or from attr IODev # called from GetIOHash with the logical hash or from attr IODev
@ -4466,9 +4538,10 @@ sub GetIOHash {
return $hash if ($hash->{TCPConn}); # for TCP/IP connected devices ioHash = hash return $hash if ($hash->{TCPConn}); # for TCP/IP connected devices ioHash = hash
return $hash if ($hash->{TYPE} eq 'Modbus'); # this is already the physical device! return $hash if ($hash->{TYPE} eq 'Modbus'); # this is already the physical device!
return $hash->{IODev} if ($hash->{IODev} return $hash->{IODev} if ($hash->{IODev}
&& IsRegisteredAtIODev($hash, $hash->{IODev})); # $hash->{IODev} is set correctly and $hash is registerd && IsRegisteredAtIODev($hash, $hash->{IODev})); # $hash->{IODev} is set correctly and registerd
Log3 $name, 4, "$name: GetIOHash (called from " . FhemCaller() . ") did not find valid IODev hash key, calling SetIODev now"; Log3 $name, 4, "$name: GetIOHash (called from " . FhemCaller() .
") did not find valid IODev hash key, calling SetIODev now";
return $hash->{IODev} if (SetIODev($hash)); # reconstruct pointer to physical device return $hash->{IODev} if (SetIODev($hash)); # reconstruct pointer to physical device
#Log3 $name, 4, '$name: GetIOHash did not find IODev attribute or matching physical serial Modbus device'; #Log3 $name, 4, '$name: GetIOHash did not find IODev attribute or matching physical serial Modbus device';
return; return;
@ -4521,6 +4594,7 @@ sub CheckIOCompat {
################################################################ ################################################################
# check if logical device is registered at io dev # check if logical device is registered at io dev
# ony called from GetIOHash
sub IsRegisteredAtIODev { sub IsRegisteredAtIODev {
my $hash = shift; my $hash = shift;
my $ioHash = shift; my $ioHash = shift;