diff --git a/fhem/FHEM/98_Modbus.pm b/fhem/FHEM/98_Modbus.pm index cce612086..a2b97503e 100755 --- a/fhem/FHEM/98_Modbus.pm +++ b/fhem/FHEM/98_Modbus.pm @@ -80,12 +80,12 @@ # 2016-12-10 more checks, more logging (include Version in Log of Send), added silentReconnect # 2016-12-17 fixed a bug when a modbus device was defined without path to a serial device # 2016-12-18 attribute to set log level for timeouts (timeoutLogLevel), openTimeout -# 2016-12-21 fixed $ret in OpenDev +# 2016-12-21 fixed $ret in keep # 2016-12-27 check for undefined $val in ParseObj and Log with timeoutLogLevel -# 2016-12-28 removed RAWBUFFER and added some initiualisation for $ioHash->{helper}{buffer}, fixed logging for timeouts +# 2016-12-28 removed RAWBUFFER and added some initiualisation for $ioHash->{READ}{BUFFER}, fixed logging for timeouts # 2017-01-02 new attribute allowShortResponses # -# 2017-01-06 removed misleading log "destination device" at define when IODev Attr is not knon yet. +# 2017-01-06 removed misleading log "destination device" at define when IODev Attr is not known yet. # 2017-01-10 call Modbus_Statistics($ioHash, "Timeouts", 0); in EndBusy to keep Reading updated even if no timeout occured # 2017-01-11 allow reconnect also for serial (add getIOHash in controlSet reconnect) in preparation for a common open # 2017-01-14 fix timeoutLogLevel usage in ReadAnswer to use physical device attrs instaed of logical device attrs @@ -113,33 +113,158 @@ # 2017-08-17 nicer logging of timeouts # 2017-09-17 extended check for missing len attribute with unpack that expects > 16 bits # in _send -# 2017-12-06 little fixes -# 2017-12-22 remember timeout time in $hash instead of reading it from intAt -# 2018-01-11 fix bug where defptr pointed to ioHash instead of logical hash when seting IODev Attr # -# ToDo / Ideas : +# 2017-12-06 restructure in order to allow Modbus slave processing +# 2018-07-14 rearrange functions, fix logical versus physical hash ... +# 2018-07-21 added tcp server functionality, relay functionality, passive mode +# 2018-10-01 fix to allow fractions of a second as interval during define +# 2018-10-06 fix bug where lrecv was stored in the {READ has instead of {REMEMBER}, +# modify registration of logical devices with their id +# add @val to ParseObj for additional unpack fields +# 2018-10-12 smaller bugfixes, new attributes enableQueueLengthReading and retriesAfterTimeout +# 2018-11-05 use DevIO_IsOpen, check if fc6 can be used or fc16 needs to be used, rework open calls +# 2018-11-10 fixed setExpr -> setexpr +# +# +# +# +# ToDo / Ideas +# learn objects in passive mode +# +# when an attr is set for a TCP slave or relay, copy attrs to running connection devices +# at modify from tcp to serial iodev hash key and DeviceName key are kept and wrong +# min / max checking as slave when we get write fcodes +# +# document serverTimeout, slave attributes, passive mode, reconnect, +# +# fix profiler calls +# option to close a tcp connection after the response has been received and only open it +# for the next request (connection handling in processRequestQueue instead of only readyfn +# +# put new connection in a special room (even hidden does not work reliably) +# conflicting definitions of attrs for expr etc. when slave uses them +# to write and then to read and send response +# test requesting fc 15 multiple coils +# test pack c/I types as response +# register offset as attribute evaluated at runtime when sending and parsing (Comptrol etc.) +# clearBufferAfterParsing als Option, die den Rest des Buffers wegwirft +# # get reading key (type / adr) # filterEcho (wie in private post im Forum vorgeschlagen) -# set saveAsModule to save attr definitions as module +# docu for set saveAsModule to save attr definitions as module and add it to .setlist # define data types VT_R4 -> revregs, len2, unpack f> ... # async output for scan? table? with revregs etc.? # get object-interpretations h123 -> Alle Variationen mit revregs und bswap und unpacks ... # nonblocking disable attr für xp # -# attr with a lits of set commands / requests to launch when polling (Helios support) +# average response time per modbus id in profiling +# reread after failed requests / timeouts -> rereadList filled in getUpdate, remove in parse? # -# passive listening to other modbus traffic (state machine, parse requests of others in special queue +# attr with a list of set commands / requests to launch when polling (Helios support) # -# set definition with multiple requests as raw containig opt. readings / input -# map mit spaces wie bei HTTPMOD -# :noArg etc. für Hintlist und userattr wie in HTTPMOD optimieren +# set/get definition with multiple requests as raw containig opt. readings / input # # Autoconfigure? (Combine testweise erhöhen, Fingerprinting -> DB?, ...?) -# Modbus Slave? separate module? -# Modbus GW feature to translate TCP requests to serial RTU / ASCII requests in Fhem # # + +#################################################################################### +# Internals / data structures +#################################################################################### + +# $hash->{MODBUSID} Modbus ID that this device is responsible for + +# $hash->{INTERVAL} Interval for cyclic request of a master device +# $hash->{RELAY} used for mode relay: name of a master device where we forward requests to +# $hash->{DeviceName} needed by DevIo to get Device, Port, Speed etc. +# $hash->{IODev} hash of the io device or this device itself if connecting through tcp +# $hash->{defptr} reference to the name of the logical device responsible for an id (defptr}{lName} => id +# $hash->{TCPConn} set to 1 if connecting through tcp/ip +# $hash->{TCPServer} set to 1 if this is a tcp server / listening device (not a connection itself) +# $hash->{TCPChild} set to 1 if this is a tcp server connection (child of a devive with TCPServer = 1) +# $hash->{EXPECT} internal state - what are we waiting for (can be request, response, idle or ...) + +# $hash->{MODE} can be master, slave, relay or passive - set during ld define +# relay is special because it to another master device to pass over requests to + +# $hash->{FRAME} the frame just received, beeing parsed / handled +# $hash->{REQUEST} the request just received, beeing parsed / handled +# $hash->{RESPONSE} the response just received, beeing parsed / handled or created + + + + +#################### +# more explanations +#################### + +# +# 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. +# +# $hash->{PROTOCOL} can be RTU, ASCII or TCP +# as with MODE the PROTOCOL key is also copied and locked to the physical io device +# +# $hash->{DEST} contains ip address/port if connection through tcp + + +# phys connection proto mode on physical device +# +# serial rtu / ascii master and slave at same time not working, +# slave can not hear master / only one master per line +# also master and passive at sime time does not make sense +# also slave and passive is useless +# 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 +# +# serial rtu / ascii passive possible, physical then can also be locked. +# +# serial tcp nonsense +# +# tcp rtu / ascii passive not possible, only master / slave. phys = logocal +# tcp same. + +# so when definig / assigning iodev, mode can be locked on physical side. +# same applies to protocol. rtu and ascii over same physical line is nonsense. + +# for connections over tcp (Modbus TCP or RTU/ASCII over TCP $ioHash = $hash during define +# so $hash->{MODBUSID}, $hash->{PROTOCOL}, $hash->{MODE}, $hash->{IODev} is available + +# for serial connections at runtime or when physical is already there when logical is defined +# and also for serial connections at startup when physical is not present when logical is defined +# NotifyFn is triggered at INITIALIZED, REREADCFG and MODIFIED. +# 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 attr IODev SetIODev is called +# ReadyFn also doesnt change anything regarding IODev / Registration + +# So mainly things are handled after a define / initialized which triggers NotifyFn for every device +# Notify calls GetIoHash which calls SetIODev +# + +# +# Exprs und Maps +# -------------- +# +# Fhem Master Expr Register in externem Gerät (read) Readings in Fhem # implemented in ParseObj +# Fhem Slave Expr Werte von externem Gerät (write) Readings in Fhem # implemented in ParseObj +# +# Fhem Master setexpr Benutzereingabe (set->write) Register in externem Gerät # implemented in Set +# Fhem Slave setexpr Readings in Fhem (read) Register zu externem Gerät # implemented in PackObj +# +# +# Fhem Master Map Registerdarstellung extern (read) Readings in Fhem # implemented in ParseObj +# Fhem Slave Map Werte von externem Gerät (write) Readings in Fhem # implemented in ParseObj +# +# Fhem Master revMap Benutzereingabe (set->write) Register in externem Gerät # implemented in Set +# Fhem Slave revMap Readings in Fhem (read) Register in externem Gerät # implemented in PackObj +# + + package main; use strict; @@ -147,6 +272,8 @@ use warnings; # return time as float, not just full seconds use Time::HiRes qw( gettimeofday tv_interval); +use TcpServerUtils; + use POSIX qw(strftime); use Encode qw(decode encode); @@ -155,13 +282,17 @@ sub Modbus_Initialize($); sub Modbus_Define($$); sub Modbus_Undef($$); sub Modbus_Read($); +sub Modbus_ReadAnswer($); sub Modbus_Ready($); -sub Modbus_ParseObj($$$;$$); -sub Modbus_ParseFrames($); -sub Modbus_HandleSendQueue($;$); -sub Modbus_TimeoutSend($); +sub ModbusLD_ParseObj($$); +sub Modbus_ParseResponse($$%); +sub Modbus_ProcessRequestQueue($;$); +sub Modbus_ResponseTimeout($); sub Modbus_CRC($); -sub ModbusLD_ObjInfo($$$;$$); +sub Modbus_SyncHashKey($$$); +sub Modbus_ObjInfo($$$;$$); +sub Modbus_CheckEval($\@$$); +sub Modbus_Open($;$$$); # functions to be used from logical modules sub ModbusLD_ExpandParseInfo($); @@ -170,17 +301,22 @@ sub ModbusLD_Define($$); sub ModbusLD_Undef($$); sub ModbusLD_Get($@); sub ModbusLD_Set($@); -sub ModbusLD_ReadAnswer($;$); + sub ModbusLD_GetUpdate($); sub ModbusLD_GetIOHash($); -sub ModbusLD_Send($$$;$$$); +sub ModbusLD_DoRequest($$$;$$$); +sub ModbusLD_StartUpdateTimer($;$); -my $Modbus_Version = '3.7.3 - 22.12.2017'; +my $Modbus_Version = '4.0.17 - 10.11.2018'; my $Modbus_PhysAttrs = "queueDelay " . + "queueMax " . + "queueTimeout " . "busDelay " . "clientSwitchDelay " . "dropQueueDoubles:0,1 " . + "enableQueueLengthReading:0,1 " . + "retriesAfterTimeout " . "profileInterval " . "openTimeout " . "nextOpenDelay " . @@ -188,13 +324,14 @@ my $Modbus_PhysAttrs = "skipGarbage:0,1 " . "timeoutLogLevel:3,4 " . "silentReconnect:0,1 "; - + my $Modbus_LogAttrs = - "queueMax " . "IODev " . # fhem.pl macht dann $hash->{IODev} = $defs{$ioname} + "queueMax " . "alignTime " . "enableControlSet:0,1 " . "nonPrioritizedSet:0,1 " . + "nonPrioritizedGet:0,1 " . "sortUpdate:0,1 " . "scanDelay "; @@ -230,8 +367,23 @@ my %Modbus_defaultFCode = ( }, ); +my %writeCode = ( + 1 => 0, + 2 => 0, + 3 => 0, + 4 => 0, + 5 => 1, + 6 => 1, + 15 => 1, + 16 => 1 +); +my %Modbus_PDUOverhead = ( + "RTU" => 3, + "ASCII" => 7, + "TCP" => 7); + ##################################### # _initialize für das physische Basismodul sub Modbus_Initialize($) @@ -255,1143 +407,6 @@ sub Modbus_Initialize($) } -##################################### -# Define für das physische serielle Basismodul -# modbus id, Intervall etc. gibt es hier nicht -# sondern im logischen Modul. -# -# entsprechend wird auch getUpdate im -# logischen Modul aufgerufen. -# -# Modbus over TCP is opened in the logical open -# -sub Modbus_Define($$) -{ - my ($ioHash, $def) = @_; - my @a = split("[ \t]+", $def); - my ($name, $type, $dev) = @a; - - return "wrong syntax: define $type [tty-devicename|none]" - if(@a < 1); - - DevIo_CloseDev($ioHash); - $ioHash->{BUSY} = 0; - $ioHash->{helper}{buffer} = ""; # clear Buffer for reception - - if(!$dev || $dev eq "none") { - Log 1, "$name: device is none, commands will be echoed only"; - return undef; - } - $ioHash->{DeviceName} = $dev; # needed by DevIo to get Device, Port, Speed etc. - $ioHash->{TIMEOUT} = AttrVal($name, "openTimeout", 3); - #DevIo_OpenDev($ioHash, 0, 0); # will be opened later in NotifyFN - delete $ioHash->{TIMEOUT}; - return; - -} - - -##################################### -# delete physical Device # todo: check other callback functions (undef, delete, shutdown) -sub Modbus_Undef($$) -{ - my ($ioHash, $arg) = @_; - my $name = $ioHash->{NAME}; - DevIo_CloseDev($ioHash); - RemoveInternalTimer ("timeout:$name"); - RemoveInternalTimer ("queue:$name"); - delete $ioHash->{nextTimeout}; - # lösche auch die Verweise aus logischen Modulen auf dieses physische. - foreach my $d (values %{$ioHash->{defptr}}) { - Log3 $name, 3, "$name: Undef is removing IO device for $d->{NAME}"; - delete $d->{IODev}; - RemoveInternalTimer ("update:$d->{NAME}"); - } - return; -} - - -######################################################## -# Notify for INITIALIZED -> Open defined logical device -# -# Bei jedem Define erzeugt Fhem.pl ein $hash{NTFY_ORDER} für das -# Device falls im Modul eine NotifyFn gesetzt ist. -# -# bei jedem Define, Rename oder Modify wird der interne Hash %ntfyHash -# gelöscht und beim nächsten Event in createNtfyHash() neu erzeugt -# wenn er nicht existiert. -# -# Im %ntfyHash wird dann für jede mögliche Event-Quelle als Key auf die Liste -# der Event-Empfänger verwiesen. -# -# die createNtfyHash() Funktion schaut für jedes Device nach $hash{NOTIFYDEV} -# falls existent wird das Gerät nur für die in $hash{NOTIFYDEV} aufgelisteten -# Event-Erzeuger in deren ntfyHash-Eintrag es Evet-Empfänger aufgenommen. -# -# Um ein Gerät als Event-Empfänger aus den Listen mit Event-Empfängern zu entfernen -# könnte man $hash{NOTIFYDEV} auf "," setzen und %ntfyHash auf () löschen... -# -# im Modul die NotifyFn zu entfernen würde den Aufruf verhindern, aber -# $hash{NTFY_ORDER} bleibt und daher erzeugt auch createNtfyHash() immer wieder verweise -# auf das Gerät, obwohl die NotifyFn nicht mehr regisrtiert ist ... -# -# -sub Modbus_Notify($$) # both for physical and logical devices -{ - my ($hash, $source) = @_; - my $name = $hash->{NAME}; # my Name - my $sName = $source->{NAME}; # Name of Device that created the events - return if($sName ne "global"); # only interested in global Events - - my $events = deviceEvents($source, 1); - return if(!$events); # no events - - # Log3 $name, 5, "$name: Notify called for source $source->{NAME} with events: @{$events}"; - return if (!grep(m/^INITIALIZED|REREADCFG|(MODIFIED $name)$/, @{$events})); - - if (IsDisabled($name)) { - Log3 $name, 3, "$name: Notify / Init: device is disabled"; - return; - } - if ($hash->{TYPE} eq "Modbus" || $hash->{DEST}) { # physical device or Modbus TCP -> open connection - Log3 $name, 3, "$name: Notify / Init: opening connection"; - Modbus_Open($hash); - } else { # logical device and not Modbus TCP -> check for IO Device - my $ioHash = ModbusLD_GetIOHash($hash); - my $ioName = $ioHash->{NAME}; - if ($ioName) { - Log3 $name, 3, "$name: Notify / Init: using $ioName for communication"; - } else { - Log3 $name, 3, "$name: Notify / Init: no IODev for communication"; - } - } - if ($hash->{TYPE} ne "Modbus") { - ModbusLD_SetTimer($hash, 1); # logical device -> first Update in 1 second or aligned if interval is defined - } - return; -} - - -################################################ -# Get Object Info from Attributes, -# parseInfo Hash or default from deviceInfo Hash -sub ModbusLD_ObjInfo($$$;$$) { - my ($hash, $key, $oName, $defName, $lastDefault) = @_; - # Device h123 unpack defUnpack - my $name = $hash->{NAME}; - my $modHash = $modules{$hash->{TYPE}}; - my $parseInfo = $modHash->{parseInfo}; - - my $reading = ($parseInfo->{$key} && $parseInfo->{$key}{reading} ? - $parseInfo->{$key}{reading} : ""); - $reading = AttrVal($name, "obj-".$key."-reading", $reading); - return (defined($lastDefault) ? $lastDefault : "") if (!$reading); - - if (defined($attr{$name})) { - - # check for explicit attribute for this object - my $aName = "obj-".$key."-".$oName; - return $attr{$name}{$aName} - if (defined($attr{$name}{$aName})); - - if ($hash->{LeadingZeros}) { - # attr for object with leading zeros in address detected - if ($key =~ /([cdih])0*([0-9]+)/) { - my $type = $1; - my $adr = $2; - while (length($adr) <= 5) { - $aName = "obj-".$type.$adr."-".$oName; - Log3 $name, 5, "$name: Check $aName"; - return $attr{$name}{$aName} - if (defined($attr{$name}{$aName})); - $adr = '0' . $adr; - } - } - } - - # check for special case: attribute can be name of reading with prefix like poll-reading - return $attr{$name}{$oName."-".$reading} - if (defined($attr{$name}{$oName."-".$reading})); - } - - # parseInfo for object $oName if special Fhem module using parseinfoHash - return $parseInfo->{$key}{$oName} - if (defined($parseInfo->{$key}) && defined($parseInfo->{$key}{$oName})); - - # check for type entry / attr ... - if ($oName ne "type") { - my $dType = ModbusLD_ObjInfo($hash, $key, 'type', 'noDefaultDevAttrForType', '***NoTypeInfo***'); - if ($dType ne '***NoTypeInfo***') { - #Log3 $name, 5, "$name: ObjInfo for $key and $oName found type $dType"; - my $typeSpec = ModbusLD_DevInfo($hash, "type-$dType", $oName, '***NoTypeInfo***'); - if ($typeSpec ne '***NoTypeInfo***') { - #Log3 $name, 5, "$name: $dType specifies $typeSpec for $oName"; - return $typeSpec; - } - } - } - - # default for object type in deviceInfo / in attributes for device / type - if ($defName) { - my $type = substr($key, 0, 1); - if (defined($attr{$name})) { - # check for explicit attribute for this object type - my $daName = "dev-".$type."-".$defName; - return $attr{$name}{$daName} - if (defined($attr{$name}{$daName})); - - # check for default attribute for all object types - my $dadName = "dev-".$defName; - return $attr{$name}{$dadName} - if (defined($attr{$name}{$dadName})); - } - my $devInfo = $modHash->{deviceInfo}; - return $devInfo->{$type}{$defName} - if (defined($devInfo->{$type}) && defined($devInfo->{$type}{$defName})); - } - return (defined($lastDefault) ? $lastDefault : ""); -} - - -################################################ -# Get Type Info from Attributes, -# or deviceInfo Hash -sub ModbusLD_DevInfo($$$;$) { - my ($hash, $type, $oName, $lastDefault) = @_; - # Device h read - - my $name = $hash->{NAME}; - my $modHash = $modules{$hash->{TYPE}}; - my $devInfo = $modHash->{deviceInfo}; - my $aName = "dev-".$type."-".$oName; - my $adName = "dev-".$oName; - - if (defined($attr{$name})) { - # explicit attribute for this object type - return $attr{$name}{$aName} - if (defined($attr{$name}{$aName})); - - # default attribute for all object types - return $attr{$name}{$adName} - if (defined($attr{$name}{$adName})); - } - # default for object type in deviceInfo - return $devInfo->{$type}{$oName} - if (defined($devInfo->{$type}) && defined($devInfo->{$type}{$oName})); - - return (defined($lastDefault) ? $lastDefault : ""); -} - - -################################################## -# Get Type/Adr for a reading name from Attributes, -# or parseInfo Hash -sub ModbusLD_ObjKey($$) { - my ($hash, $reading) = @_; - my $name = $hash->{NAME}; - my $modHash = $modules{$hash->{TYPE}}; - my $parseInfo = $modHash->{parseInfo}; - - foreach my $a (keys %{$attr{$name}}) { - if ($a =~ /obj-([cdih][0-9]+)-reading/ && $attr{$name}{$a} eq $reading) { - return $1; - } - } - foreach my $k (keys %{$parseInfo}) { - return $k if ($parseInfo->{$k}{reading} && ($parseInfo->{$k}{reading} eq $reading)); - } - return ""; -} - - -sub Modbus_CheckEval($$$$$) { - my ($hash, $val, $expr, $context, $eName) = @_; - # context e.g. "ParseObj", eName e.g. "ignoreExpr for $reading" - my $name = $hash->{NAME}; - my $result; - my $inCheckEval = 1; - my $oldSig = ($SIG{__WARN__} ? $SIG{__WARN__} : 'DEFAULT'); - Log3 $name, 5, "$name: $context evaluates $eName, val=$val, expr $expr"; - $SIG{__WARN__} = sub { Log3 $name, 3, "$name: $context warning evaluating $eName, val=$val, expr $expr: @_"; }; - $result = eval($expr); - $SIG{__WARN__} = $oldSig; - if ($@) { - Log3 $name, 3, "$name: $context error evaluating $eName, val=$val, expr=$expr: $@"; - } else { - Log3 $name, 5, "$name: $context eval result is $result"; - } - return $result; -} - - -################################################# -# Parse holding / input register / coil Data -# only called from parseframes -# which is only called from read / readanswer -# -# with logical device hash, data string -# and the object type/adr to start with -sub Modbus_ParseObj($$$;$$) { - my ($logHash, $data, $objCombi, $quantity, $op) = @_; - my $name = $logHash->{NAME}; - my $type = substr($objCombi, 0, 1); - my $startAdr = substr($objCombi, 1); - my $lastAdr = ($quantity ? $startAdr + $quantity -1 : 0); - my ($unpack, $format, $expr, $ignExpr, $map, $rest, $len, $encode, $decode); - Log3 $name, 5, "$name: ParseObj called with " . unpack ("H*", $data) . " and start $startAdr" . ($quantity ? ", quantity $quantity" : "") . ($op ? ", op $op" : "");; - - if ($type =~ "[cd]") { - # quantity is only used for coils / discrete inputs - $quantity = 1 if (!$quantity); - $rest = unpack ("b$quantity", $data); # convert binary data to bit string - Log3 $name, 5, "$name: ParseObj shortened bit string: " . $rest . " and start adr $startAdr, quantity $quantity"; - } else { - $rest = $data; - } - use bytes; - readingsBeginUpdate($logHash); - while (length($rest) > 0) { - # einzelne Felder verarbeiten - my $key = $type . $startAdr; - my $reading = ModbusLD_ObjInfo($logHash, $key, "reading"); # "" if nothing specified - - if ($op =~ /scanid([0-9]+)/) { # scanning for Modbus ID - $reading = "scanId-" . $1 . "-Response-$key"; - $logHash->{MODBUSID} = $1; - Log3 $name, 3, "$name: ScanIds got reply from Id $1 - set internal MODBUSID to $1"; - } elsif ($op eq 'scanobj') { # scan Modbus objects - if (!$reading) { - my $fKey = $type . sprintf ("%06d", $startAdr); - $reading = "scan-$fKey"; - CommandAttr(undef, "$name obj-${fKey}-reading $reading"); - } - if ($type =~ "[hi]") { - my $l = length($rest) / 2; - $l = 1 if ($l < 1); - CommandAttr(undef, "$name dev-h-defLen $l") - if (AttrVal($name, "dev-h-defLen", "") ne "$l"); - CommandAttr(undef, "$name dev-h-defUnpack a" . $l*2) - if (AttrVal($name, "dev-h-defUnpack", "") ne ('a'.$l*2)); - CommandAttr(undef, "$name dev-h-defExpr ModbusLD_ScanFormat(\$hash, \$val)") - if (AttrVal($name, "dev-h-defExpr", "") ne "ModbusLD_ScanFormat(\$hash, \$val)"); - } - } - if ($reading) { - if ($type =~ "[cd]") { - $unpack = "a"; # for coils just take the next 0/1 from the string - $len = 1; # one byte contains one bit from the 01001100 string unpacked above - } else { - $unpack = ModbusLD_ObjInfo($logHash, $key, "unpack", "defUnpack", "n"); - $len = ModbusLD_ObjInfo($logHash, $key, "len", "defLen", 1); # default to 1 Reg / 2 Bytes - $encode = ModbusLD_ObjInfo($logHash, $key, "encode", "defEncode"); # character encoding - $decode = ModbusLD_ObjInfo($logHash, $key, "decode", "defDecode"); # character decoding - my $revRegs = ModbusLD_ObjInfo($logHash, $key, "revRegs", "defRevRegs"); # do not reverse register order by default - my $swpRegs = ModbusLD_ObjInfo($logHash, $key, "bswapRegs", "defBswapRegs"); # dont reverse bytes in registers by default - - $rest = Modbus_RevRegs($logHash, $rest, $len) if ($revRegs && $len > 1); - $rest = Modbus_SwpRegs($logHash, $rest, $len) if ($swpRegs); - }; - $format = ModbusLD_ObjInfo($logHash, $key, "format", "defFormat"); # no format if nothing specified - $expr = ModbusLD_ObjInfo($logHash, $key, "expr", "defExpr"); - $ignExpr = ModbusLD_ObjInfo($logHash, $key, "ignoreExpr", "defIgnoreExpr"); - $map = ModbusLD_ObjInfo($logHash, $key, "map", "defMap"); # no map if not specified - Log3 $name, 5, "$name: ParseObj ObjInfo for $key: reading=$reading, unpack=$unpack, expr=$expr, format=$format, map=$map"; - - my $val = unpack ($unpack, $rest); # verarbeite so viele register wie passend (ggf. über mehrere Register) - - if (!defined($val)) { - my $logLvl = AttrVal($name, "timeoutLogLevel", 3); - Log3 $name, $logLvl, "$name: ParseObj unpack of " . unpack ('H*', $rest) . " with $unpack for $reading resulted in undefined value"; - } else { - Log3 $name, 5, "$name: ParseObj unpacked " . unpack ('H*', $rest) . - " with $unpack to hex " . unpack ('H*', $val) . - ($val =~ /[[:print:]]/ ? " ($val)" : ""); # check for printable characters - - $val = decode($decode, $val) if ($decode); - $val = encode($encode, $val) if ($encode); - - # Exp zur Ignorieren der Werte? - my $ignore; - $ignore = Modbus_CheckEval($logHash, $val, $ignExpr, "ParseObj", "ignoreExpr for $reading") if ($ignExpr); - - # Exp zur Nachbearbeitung der Werte? - $val = Modbus_CheckEval($logHash, $val, $expr, "ParseObj", "expr for $reading") if ($expr); - - # Map zur Nachbereitung der Werte? - if ($map) { - my %map = split (/[,: ]+/, $map); - Log3 $name, 5, "$name: ParseObj for $reading maps value to $val with " . $map; - $val = $map{$val} if ($map{$val}); - } - # Format angegeben? - if ($format) { - Log3 $name, 5, "$name: ParseObj for $reading does sprintf with format " . $format . - " value is $val"; - $val = sprintf($format, $val); - Log3 $name, 5, "$name: ParseObj for $reading sprintf result is $val"; - } - if ($ignore) { - Log3 $name, 4, "$name: ParseObj for $reading ignores $val because of ignoreExpr. Reading not updated"; - } else { - Log3 $name, 4, "$name: ParseObj for $reading assigns $val"; - readingsBulkUpdate($logHash, $reading, $val); - $logHash->{gotReadings}{$reading} = $val; - $logHash->{lastRead}{$key} = gettimeofday(); - } - } - } else { - Log3 $name, 5, "$name: ParseObj has no information about parsing $key"; - $len = 1; - } - - # gehe zum nächsten Wert - if ($type =~ "[cd]") { - $startAdr++; - if (length($rest) > 1) { - $rest = substr($rest, 1); - } else { - $rest = ""; - } - last if ($lastAdr && $startAdr > $lastAdr); - } else { - $startAdr += $len; - if (length($rest) > ($len*2)) { - $rest = substr($rest, $len * 2); # take rest of rest starting at len*2 until the end - } else { - $rest = ""; - } - } - Log3 $name, 5, "$name: ParseObj moves to next object, skip $len to $type$startAdr" if ($rest); - } - readingsEndUpdate($logHash, 1); - return; -} - - -##################################### -sub Modbus_Statistics($$$) -{ - my ($hash, $key, $value) = @_; - my $name = $hash->{NAME}; - - my $pInterval = AttrVal($name, "profileInterval", 0); - return if (!$pInterval); - - my $now = gettimeofday(); - my $pPeriod = int($now / $pInterval); - - if (!defined ($hash->{statistics}{lastPeriod}) || ($pPeriod != $hash->{statistics}{lastPeriod})) { - readingsBeginUpdate($hash); - foreach my $k (keys %{$hash->{statistics}{sums}}) { - readingsBulkUpdate($hash, "Statistics_" . $k, $hash->{statistics}{sums}{$k}); - $hash->{statistics}{sums}{$k} = 0; - } - readingsEndUpdate($hash, 1); - $hash->{statistics}{sums}{$key} = $value; - $hash->{statistics}{lastPeriod} = $pPeriod; - } else { - if ($hash->{statistics}{sums}{$key}) { - $hash->{statistics}{sums}{$key} += $value; - } else { - $hash->{statistics}{sums}{$key} = $value; - } - } - return; -} - - -##################################### -sub Modbus_Profiler($$) -{ - my ($hash, $key) = @_; - my $name = $hash->{NAME}; - - my $pInterval = AttrVal($name, "profileInterval", 0); - return if (!$pInterval); - - my $now = gettimeofday(); - my $pPeriod = int($now / $pInterval); - #my $micros = $now - (int ($now)); - #my ($seconds, $minute, $hour, @rest) = localtime ($now); - - # erster Aufruf? dann lastKey setzen und Startzeit merken, lastPeriod setzen - if (!defined ($hash->{profiler}{lastKey})) { - $hash->{profiler}{lastKey} = $key; - $hash->{profiler}{lastPeriod} = $pPeriod; - $hash->{profiler}{start}{$key} = $now; - $hash->{profiler}{sums}{$key} = 0 ; - Log3 $name, 5, "$name: Profiling: $key initialized, start $now"; - return; - } - - # merke letzten Key - für diesen ist bisher die Zeit vergangen - my $lKey = $hash->{profiler}{lastKey}; - - # für den letzten Key: Diff seit Start - my $lDiff = ($now - $hash->{profiler}{start}{$lKey}); - $lDiff = 0 if (!$hash->{profiler}{start}{$lKey}); - - # für den neuen Key: wenn noch kein start, dann startet die Messung jetzt - if (!$hash->{profiler}{start}{$key}) { - $hash->{profiler}{start}{$key} = $now; - } - - Log3 $name, 5, "$name: Profiling: $key, before $lKey, now is $now, $key started at " - . $hash->{profiler}{start}{$key} . ", $lKey started at " . $hash->{profiler}{start}{$lKey}; - - # neue Minute - if ($pPeriod != $hash->{profiler}{lastPeriod}) { - my $overP = $now - ($pPeriod * $pInterval); # time over the pPeriod start - $overP = 0 if ($overP > $lDiff); # if interval was modified things get inconsistant ... - Log3 $name, 5, "$name: Profiling: pPeriod changed, last pPeriod was " . $hash->{profiler}{lastPeriod} . - " now $pPeriod, total diff for $lKey is $lDiff, over $overP over the pPeriod"; - Log3 $name, 5, "$name: Profiling: add " . ($lDiff - $overP) . " to sum for $key"; - $hash->{profiler}{sums}{$lKey} += ($lDiff - $overP); - - readingsBeginUpdate($hash); - foreach my $k (keys %{$hash->{profiler}{sums}}) { - my $val = sprintf("%.2f", $hash->{profiler}{sums}{$k}); - Log3 $name, 5, "$name: Profiling: set reading for $k to $val"; - readingsBulkUpdate($hash, "Profiler_" . $k . "_sum", $val); - $hash->{profiler}{sums}{$k} = 0; - $hash->{profiler}{start}{$k} = 0; - } - readingsEndUpdate($hash, 0); - - $hash->{profiler}{start}{$key} = $now; - - Log3 $name, 5, "$name: Profiling: set new sum for $lKey to $overP"; - $hash->{profiler}{sums}{$lKey} = $overP; - $hash->{profiler}{lastPeriod} = $pPeriod; - $hash->{profiler}{lastKey} = $key; - } else { - if ($key eq $hash->{profiler}{lastKey}) { - # nothing new - take time when key or pPeriod changes - return; - } - Log3 $name, 5, "$name: Profiling: add $lDiff to sum for $lKey " . - "(now is $now, start for $lKey was $hash->{profiler}{start}{$lKey})"; - $hash->{profiler}{sums}{$lKey} += $lDiff; - $hash->{profiler}{start}{$key} = $now; - $hash->{profiler}{lastKey} = $key; - } - return; -} - - -##################################### -# Called from the read and readanswer functions with hash -# of device that is reading (phys / log depending on TCP / RTU -# $ioHash->{REQUEST} holds request that was last sent -# log hash is taken from last request -# return: "text" is error, 0 is ignore, 1 is finished with success -sub Modbus_ParseFrames($) -{ - my $ioHash = shift; # hash of io device given to function - - my $name = $ioHash->{NAME}; # name of io device - my $frame = $ioHash->{helper}{buffer}; # frame is in buffer in io hash - my $logHash = $ioHash->{REQUEST}{DEVHASH}; # logical device hash is saved in io hash (or points back to self) - my $type = $ioHash->{REQUEST}{TYPE}; - my $adr = $ioHash->{REQUEST}{ADR}; - my $reqLen = $ioHash->{REQUEST}{LEN}; - my $reqId = $ioHash->{REQUEST}{MODBUSID}; - my $proto = $ioHash->{REQUEST}{PROTOCOL}; - my $op = $ioHash->{REQUEST}{OPERATION}; - my ($null, $dlen, $devAdr, $pdu, $fCode, $data, $eCRC, $CRC); - my $tid = 0; - - return "got data but did not send a request - ignoring" if (!$ioHash->{REQUEST} || !$proto); - Log3 $name, 5, "$name: ParseFrames got: " . unpack ('H*', $frame); - - use bytes; - - if ($proto eq "RTU") { - if (AttrVal($name, "skipGarbage", 0)) { - my $start = index($frame, pack('C', $reqId)); - if ($start) { - my $skip = substr($frame, 0, $start); - $frame = substr($frame, $start); - Log3 $name, 4, "$name: ParseFrames skipped $start bytes (" . - unpack ('H*', $skip) . " from " . unpack ('H*', $frame) . ")"; - $ioHash->{helper}{buffer} = $frame; - } - } - if ($frame =~ /(..)(.+)(..)/s) { # (id fCode) (data) (crc) /s means treat as single line ... - ($devAdr, $fCode) = unpack ('CC', $1); - $data = $2; - $eCRC = unpack ('v', $3); # Header CRC - thats what we expect to calculate - $CRC = Modbus_CRC($1.$2); # calculated CRC of data - } else { - return undef; # data still incomplete - continue reading - } - } elsif ($proto eq "ASCII") { - if (AttrVal($name, "skipGarbage", 0)) { - my $start = index($frame, ':'); - if ($start) { - my $skip = substr($frame, 0, $start); - $frame = substr($frame, $start); - Log3 $name, 4, "$name: ParseFrames skipped $start bytes ($skip from $frame)"; - $ioHash->{helper}{buffer} = $frame; - } - } - if ($frame =~ /:(..)(..)(.+)(..)\r\n/) {# : (id) (fCode) (data) (lrc) \r\n - $devAdr = hex($1); - $fCode = hex($2); - $data = pack('H*', $3); - $eCRC = hex($4); # Header CRC (LRC) - $CRC = Modbus_LRC(pack('C', $devAdr) . pack ('C', $fCode) . $data); # calculate LRC of data - } else { - return undef; # data still incomplete - continue reading - } - - } elsif ($proto eq "TCP") { - $CRC = 0; $eCRC = 0; # for later check for all protocols (not needed for TCP) - if (length($frame) < 8) { - Log3 $name, 5, "$name: ParseFrames: length too small: " . length($frame); - return undef; - } - ($tid, $null, $dlen, $devAdr, $pdu) = unpack ('nnnCa*', $frame); - if ($ioHash->{REQUEST}{TID} != $tid) { - Log3 $name, 5, "$name: ParseFrames: wrong tid ($tid), dlen=$dlen, id=$devAdr, rest=" . unpack ('H*', $pdu); - # maybe old response after timeount, maybe rest after wrong frame is the one we're looking for - $frame = substr($frame, $dlen + 6); # remove wrong frame - Log3 $name, 5, "$name: ParseFrames: takes rest after frame: " . unpack ('H*', $frame); - if (length($frame) < 8) { - Log3 $name, 5, "$name: ParseFrames: length of rest is too small: " . length($frame); - return undef; - } - ($tid, $null, $dlen, $devAdr, $pdu) = unpack ('nnnCa*', $frame); - Log3 $name, 5, "$name: ParseFrames: unpacked rest as tid=$tid, dlen=$dlen, id=$devAdr, pdu=" . unpack ('H*', $pdu); - if ($ioHash->{REQUEST}{TID} != $tid) { - return ("got wrong tid ($tid)"); - } - } - if (length($pdu) + 1 < $dlen) { - Log3 $name, 5, "$name: ParseFrames: Modbus TCP PDU too small (expect $dlen): " . (length($pdu) + 1); - return undef; - } - ($fCode, $data) = unpack ('Ca*', $pdu); - } else { - Log3 $name, 3, "$name: ParseFrames: request structure contains unknown protocol $proto"; - } - - Log3 $name, 3, "$name: ParseFrames got a copy of the request sent before - looks like an echo!" - if ($frame eq $ioHash->{REQUEST}{FRAME} && $fCode < 5); - - return "recieved frame from unexpected Modbus Id $devAdr, " . - "expecting fc $ioHash->{REQUEST}{FCODE} from $reqId for device $logHash->{NAME}" - if ($devAdr != $reqId && $reqId != 0); - - return "unexpected function code $fCode from $devAdr, ". - "expecting fc $ioHash->{REQUEST}{FCODE} from $reqId for device $logHash->{NAME}" - if ($ioHash->{REQUEST}{FCODE} != $fCode && $fCode < 128); - - # - # frame received, now handle pdu data - # - $logHash->{helper}{lrecv} = gettimeofday(); # logical module side - Modbus_Profiler($ioHash, "Fhem"); - delete $logHash->{gotReadings}; # will be filled by ParseObj later - - my $values = $data; # real value part of data (typically after a length byte) - will be overwritten - my $actualLen = length ($data); # actually read length of data part (registers / coils / ...) for comparison - my $headerLen = 4; # expected len for some fcodes, will be overwritten for others - my $parseAdr = $adr; # default, can be overwritten if adr is contained in reply - my $quantity = 0; # only used for coils / di and fcode 1 or 2. If 0 parseObj ignores it - - if ($fCode == 1 || $fCode == 2) { # read coils / discrete inputs, pdu: bytes, coils - ($headerLen, $values) = unpack ('Ca*', $data); - $actualLen = length ($values); - $quantity = $reqLen; # num of coils - } elsif ($fCode == 3 || $fCode == 4) { # read holding/input registers, pdu: bytes, registers - ($headerLen, $values) = unpack ('Ca*', $data); - if (ModbusLD_DevInfo($logHash, "h", "brokenFC3", 0)) { - Log3 $name, 5, "$name: ParseFrames uses fix for broken fcode 3"; - ($parseAdr, $values) = unpack ('na*', $data); - $headerLen = 4; - } - $actualLen = length ($values); - } elsif ($fCode == 5) { # write single coil, pdu: adr, coil (FF00) - ($parseAdr, $values) = unpack ('nH4', $data); - if (ModbusLD_DevInfo($logHash, "c", "brokenFC5", 0)) { - Log3 $name, 5, "$name: ParseFrames uses fix for broken fcode 5"; - $values = ($values eq "0000" ? 0 : 1); - } else { - $values = ($values eq "ff00" ? 1 : 0); - } - $quantity = 1; - # length of $data should be 4 - } elsif ($fCode == 6) { # write single (holding) register, pdu: adr, register - ($parseAdr, $values) = unpack ('na*', $data); - # length of $data should be 4 - } elsif ($fCode == 15 || $fCode == 16) { # write mult coils/hold. regis, pdu: adr, quantity - ($parseAdr, $quantity) = unpack ('nn', $data); - # quantity is only used for coils -> ignored for fcode 16 later - # length of $data should be 4 - } elsif ($fCode < 128) { # other function code - Log3 $name, 3, "$name: ParseFrames: function code $fCode not implemented"; - return "function code $fCode not implemented"; - } - - if ($fCode >= 128) { # error - my $hexdata = unpack ("H2", $data); - my $hexFCode = unpack ("H*", pack("C", $fCode)); - my $errCode = $Modbus_errCodes{$hexdata}; - Log3 $name, 4, "$name: ParseFrames got error code $hexFCode / $hexdata" . - ($errCode ? ", $errCode" : ""); - return "device replied with exception code $hexFCode / $hexdata" . ($errCode ? ", $errCode" : ""); - } else { - if ($headerLen > $actualLen) { - if ($eCRC != $CRC) { - Log3 $name, 5, "$name: ParseFrames: wait for more data ($actualLen / $headerLen)"; - return undef; - } elsif (!ModbusLD_DevInfo($logHash, $type, "allowShortResponses", 0)) { - Log3 $name, 5, "$name: ParseFrames: wait for more data ($actualLen / $headerLen)"; - return undef; - } - Log3 $name, 5, "$name: ParseFrames: frame seems incomplete ($actualLen / $headerLen) but checksum is fine and allowShortResponses is set ..."; - } - return "ParseFrames got wrong Checksum (expect $eCRC, got $CRC)" if ($eCRC != $CRC); - Log3 $name, 4, "$name: ParseFrames got fcode $fCode from $devAdr" . - ($proto eq "TCP" ? ", tid $tid" : "") . - ", values " . unpack ('H*', $values) . "HeaderLen $headerLen, ActualLen $actualLen" . - ", request was for $type$adr ($ioHash->{REQUEST}{READING})". - ", len $reqLen for module $logHash->{NAME}"; - if ($fCode < 15) { - # nothing to parse after reply to 15 / 16 - Modbus_ParseObj($logHash, $values, $type.$parseAdr, $quantity, $op); - Log3 $name, 5, "$name: ParseFrames got " . scalar keys (%{$logHash->{gotReadings}}) . " readings from ParseObj"; - } else { - Log3 $name, 5, "$name: reply to fcode 15 and 16 does not contain values"; - } - return 1; - } - return; -} - - - -##################################### -# End of BUSY -# called with physical device hash -sub Modbus_EndBUSY($) -{ - my $hash = shift; - my $name = $hash->{NAME}; - - $hash->{helper}{buffer} = ""; - $hash->{BUSY} = 0; - delete $hash->{REQUEST}; - delete $hash->{nextTimeout}; - Modbus_Profiler($hash, "Idle"); - Modbus_Statistics($hash, "Timeouts", 0); # damit bei Bedarf das Reading gesetzt wird - RemoveInternalTimer ("timeout:$name"); - return; -} - - -##################################### -# Called from the global loop, when the select for hash->{FD} reports data -# hash is hash of the physical device ( = logical device for TCP) -sub Modbus_Read($) -{ - # physical layer function - read to common physical buffers ... - my $hash = shift; - my $name = $hash->{NAME}; - my $buf = DevIo_SimpleRead($hash); - return if(!defined($buf)); - my $now = gettimeofday(); - - Modbus_Profiler($hash, "Read"); - Log3 $name, 5, "$name: raw read: " . unpack ('H*', $buf); - - $hash->{helper}{buffer} .= $buf; - $hash->{helper}{lrecv} = $now; # physical side - - my $code = Modbus_ParseFrames($hash); - if ($code) { - if ($code ne "1") { - Log3 $name, 5, "$name: ParseFrames returned error: $code" - } - delete $hash->{TIMEOUTS}; - Modbus_EndBUSY ($hash); # set BUSY to 0, delete REQUEST, clear Buffer, do Profilig - RemoveInternalTimer ("queue:$name"); - Modbus_HandleSendQueue ("direct:$name"); # don't wait for next regular handle queue slot - } - return; -} - - -########################### -# open connection -# $hash is physical or both (TCP) -# called from set reconnect, Attr (disable), Notify (initialized, rereadcfg, |(MODIFIED $name)), Ready -sub Modbus_Open($;$) -{ - my ($hash, $reopen) = @_; - my $name = $hash->{NAME}; - my $now = gettimeofday(); - $reopen = 0 if (!$reopen); - - if ($hash->{BUSY_OPENDEV}) { # still waiting for callback to last open - if ($hash->{LASTOPEN} && $now > $hash->{LASTOPEN} + (AttrVal($name, "openTimeout", 3) * 2) - && $now > $hash->{LASTOPEN} + 15) { - Log3 $name, 5, "$name: _Open - still waiting for open callback, timeout is over twice - this should never happen"; - Log3 $name, 5, "$name: _Open - stop waiting and reset the flag."; - $hash->{BUSY_OPENDEV} = 0; - } else { - Log3 $name, 5, "$name: _Open - still waiting for open callback"; - return; - } - } - - if (!$reopen) { # not called from _Ready - DevIo_CloseDev($hash); - delete $hash->{NEXT_OPEN}; - delete $hash->{DevIoJustClosed}; - } - - Log3 $name, 4, "$name: trying to open connection to $hash->{DeviceName}" if (!$reopen); - $hash->{IODev} = $hash if ($hash->{DEST}); # for TCP Log-Module itself is IODev (removed during CloseDev) - $hash->{BUSY} = 0; - $hash->{BUSY_OPENDEV} = 1; - $hash->{LASTOPEN} = $now; - $hash->{nextOpenDelay} = AttrVal($name, "nextOpenDelay", 60); - $hash->{devioLoglevel} = (AttrVal($name, "silentReconnect", 0) ? 4 : 3); - $hash->{TIMEOUT} = AttrVal($name, "openTimeout", 3); - $hash->{helper}{buffer} = ""; # clear Buffer for reception - - DevIo_OpenDev($hash, $reopen, 0, \&Modbus_OpenCB); - delete $hash->{TIMEOUT}; - return; -} - - -# ready fn for physical device -# and logical device (in case of tcp when logical device opens connection) -########################################################################### -sub Modbus_Ready($) -{ - my ($hash) = @_; - my $name = $hash->{NAME}; - - if($hash->{STATE} eq "disconnected") { - if (IsDisabled($name)) { - Log3 $name, 3, "$name: _Reconnect: $name is disabled - don't try to reconnect"; - DevIo_CloseDev($hash); - $hash->{BUSY} = 0; - return; - } - Modbus_Open($hash, 1); # reopen, dont call DevIoClose before reopening - return; # a return value only triggers direct read for windows - main loop will select for data - } - # This is relevant for windows/USB only - my $po = $hash->{USBDev}; - if ($po) { - my ($BlockingFlags, $InBytes, $OutBytes, $ErrorFlags) = $po->status; - return ($InBytes>0); # tell fhem.pl to read when we return - } - return; -} - - -##################################### -sub Modbus_CRC($) { - use bytes; - my $frame = shift; - my $crc = 0xFFFF; - my ($chr, $lsb); - for my $i (0..bytes::length($frame)-1) { - $chr = ord(bytes::substr($frame, $i, 1)); - $crc ^= $chr; - for (1..8) { - $lsb = $crc & 1; - $crc >>= 1; - $crc ^= 0xA001 if $lsb; - } - } - no bytes; - return $crc; -} - - -##################################### -sub Modbus_LRC($) { - use bytes; - my $frame = shift; - my $lrc = 0; - my $chr; - for my $i (0..bytes::length($frame)-1) { - $chr = ord(bytes::substr($frame, $i, 1)); - $lrc = ($lrc + $chr) & 0xff; - } - return (0xff - $lrc) +1; -} - - -####################################### -sub Modbus_CountTimeouts($) -{ - my ($hash) = @_; - my $name = $hash->{NAME}; - - if ($hash->{DEST}) { - # modbus TCP/RTU/ASCII over TCP - if ($hash->{TIMEOUTS}) { - $hash->{TIMEOUTS}++; - my $max = AttrVal($name, "maxTimeoutsToReconnect", 0); - if ($max && $hash->{TIMEOUTS} >= $max) { - Log3 $name, 3, "$name: $hash->{TIMEOUTS} successive timeouts, setting state to disconnected"; - DevIo_Disconnected($hash); - } - } else { - $hash->{TIMEOUTS} = 1; - } - } - return; -} - - -####################################### -# Aufruf aus InternalTimer mit "timeout:$name" -# wobei name das physical device ist -sub Modbus_TimeoutSend($) -{ - my $param = shift; - my (undef,$name) = split(':',$param); - my $ioHash = $defs{$name}; - my $logLvl = AttrVal($name, "timeoutLogLevel", 3); - Log3 $name, $logLvl, "$name: timeout waiting for fc $ioHash->{REQUEST}{FCODE} " . - "from id $ioHash->{REQUEST}{MODBUSID}, " . - "Request was $ioHash->{REQUESTHEX}" . - " ($ioHash->{REQUEST}{TYPE}$ioHash->{REQUEST}{ADR} / $ioHash->{REQUEST}{READING}, len $ioHash->{REQUEST}{LEN})" . - ($ioHash->{helper}{buffer} ? ", Buffer contains " . unpack ("H*", $ioHash->{helper}{buffer}) : ""); - - Modbus_Statistics($ioHash, "Timeouts", 1); - Modbus_EndBUSY ($ioHash); # set BUSY to 0, delete REQUEST, clear Buffer, do Profilig, remove internalTimer - Modbus_CountTimeouts ($ioHash); - Modbus_HandleSendQueue ("direct:$name"); # verwaltet auch idle und busy time statistics variables - return; -}; - - -####################################### -# prüfe delays vor dem Senden -sub Modbus_CheckDelay($$$$$$) -{ - my ($ioHash, $devName, $force, $title, $delay, $last) = @_; - return if (!$delay); - my $now = gettimeofday(); - my $name = $ioHash->{NAME}; - my $t2 = $last + $delay; - my $rest = $t2 - $now; - - Log3 $name, 5, "$name: handle queue check $title ($delay) for $devName: rest $rest"; - if ($rest > 0) { - Modbus_Profiler($ioHash, "Delay"); - if ($force) { - Log3 $name, 4, "$name: HandleSendQueue / CheckDelay $title ($delay) for $devName not over, sleep $rest forced"; - sleep $rest if ($rest > 0 && $rest < $delay); - return 0; - } else { - InternalTimer($t2, "Modbus_HandleSendQueue", "queue:$name", 0); - Log3 $name, 4, "$name: HandleSendQueue / CheckDelay $title ($delay) for $devName not over, try again in $rest"; - return 1; - } - } - return 0; -} - - -####################################### -# Aufruf aus InternalTimer mit "queue:$name" -# oder direkt mit "direkt:$name -# wobei name das physical device ist -# greift über den Request der Queue auf das logische Device zu -# um Timings und Zeitstempel zu verarbeiten -sub Modbus_HandleSendQueue($;$) -{ - my (undef,$name) = split(':', shift); - my $force = shift; - my $ioHash = $defs{$name}; - my $queue = $ioHash->{QUEUE}; - my $now = gettimeofday(); - - #Log3 $name, 5, "$name: handle queue" . ($force ? ", force" : ""); - RemoveInternalTimer ("queue:$name"); - - return if(!defined($queue) || @{$queue} == 0); - - my $queueDelay = AttrVal($name, "queueDelay", 1); - - if ($ioHash->{STATE} eq "disconnected") { - Log3 $name, 4, "$name: handle queue: device is disconnected, dropping requests in queue"; - Modbus_Profiler($ioHash, "Idle"); - delete $ioHash->{QUEUE}; - return; - } - if (IsDisabled($name)) { - Log3 $name, 4, "$name: HandleSendQueue called but device is disabled. Dropping requests in queue"; - Modbus_Profiler($ioHash, "Idle"); - delete $ioHash->{QUEUE}; - return; - } - if (!$init_done) { # fhem not initialized, wait with IO - InternalTimer($now+$queueDelay, "Modbus_HandleSendQueue", "queue:$name", 0); - Log3 $name, 3, "$name: handle queue: not available yet (init not done), try again in $queueDelay seconds"; - return; - } - if ($ioHash->{BUSY}) { # still waiting for reply to last request - InternalTimer($now+$queueDelay, "Modbus_HandleSendQueue", "queue:$name", 0); - #Log3 $name, 5, "$name: handle queue: busy, try again in $queueDelay seconds"; - #Modbus_Profiler($ioHash, "Wait"); - return; - } - - return if ((!$queue) || (!$queue->[0])); # nothing in queue - - # get top element from Queue - my $request = $queue->[0]; - if (!$request->{FCODE}) { - Log3 $name, 4, "$name: HandleSendQueue called with empty fcode entry. Dropping request"; - shift(@{$queue}); # remove first element from queue - return; - } - - my $reading = $request->{READING}; - my $len = $request->{LEN}; - my $tid = $request->{TID}; - my $adr = $request->{ADR}; - my $reqId = $request->{MODBUSID}; - my $proto = $request->{PROTOCOL}; - my $type = $request->{TYPE}; - my $fCode = $request->{FCODE}; - my $v1 = $request->{VALUE}; - my $logHash = $request->{DEVHASH}; - - if (IsDisabled($logHash->{NAME})) { - Log3 $name, 4, "$name: HandleSendQueue called but logical device is disabled. Dropping request"; - shift(@{$queue}); # remove first element from queue - #Modbus_Profiler($ioHash, "Idle"); - # todo: profiler? - return; - } - - # todo: check profiler setting in case delays not over - # check defined delays - if ($ioHash->{helper}{lrecv}) { - #Log3 $name, 5, "$name: check busDelay ..."; - return if (Modbus_CheckDelay($ioHash, $name, $force, - "busDelay", AttrVal($name, "busDelay", 0), - $ioHash->{helper}{lrecv})); - #Log3 $name, 5, "$name: check clientSwitchDelay ..."; - my $clSwDelay = AttrVal($name, "clientSwitchDelay", 0); - if ($clSwDelay && $ioHash->{helper}{lid} - && $reqId != $ioHash->{helper}{lid}) { - return if (Modbus_CheckDelay($ioHash, $name, $force, - "clientSwitchDelay", $clSwDelay, - $ioHash->{helper}{lrecv})); - } - } - if ($logHash->{helper}{lrecv}) { - return if (Modbus_CheckDelay($ioHash, $logHash->{NAME}, $force, - "commDelay", ModbusLD_DevInfo($logHash, "timing", "commDelay", 0.1), - $logHash->{helper}{lrecv})); - } - if ($logHash->{helper}{lsend}) { - return if (Modbus_CheckDelay($ioHash, $logHash->{NAME}, $force, - "sendDelay", ModbusLD_DevInfo($logHash, "timing", "sendDelay", 0.1), - $logHash->{helper}{lsend})); - } - Log3 $name, 5, "$name: HandleSendQueue: finished delay checking, proceed with sending"; - - my $data; - if ($fCode == 1 || $fCode == 2) { # read coils / discrete inputs, pdu: StartAdr, Len (=number of coils) - $data = pack ('nn', $adr, $len); - } elsif ($fCode == 3 || $fCode == 4) { # read holding/input registers, pdu: StartAdr, Len (=number of regs) - $data = pack ('nn', $adr, $len); - } elsif ($fCode == 5) { # write single coil, pdu: StartAdr, Value (1-bit as FF00) - if (ModbusLD_DevInfo($logHash, "c", "brokenFC5", 0)) { - my $oneCode = lc ModbusLD_DevInfo($logHash, "c", "brokenFC5"); - $data = pack ('nH4', $adr, (unpack ('n',$v1) ? $oneCode : "0000")); - } else { - $data = pack ('nH4', $adr, (unpack ('n',$v1) ? "FF00" : "0000")); - } - } elsif ($fCode == 6) { # write single register, pdu: StartAdr, Value - $data = pack ('n', $adr) . $v1; - } elsif ($fCode == 15) { # write multiple coils, pdu: StartAdr, NumOfCoils, ByteCount, Values - $data = pack ('nnCC', $adr, int($len/8)+1, $len, $v1); # todo: test / fix - } elsif ($fCode == 16) { # write multiple regs, pdu: StartAdr, NumOfRegs, ByteCount, Values - $data = pack ('nnC', $adr, $len, $len*2) . $v1; - } else { # function code not implemented yet - Log3 $name, 3, "$name: Send function code $fCode not yet implemented"; - return; - } - my $pdu = pack ('C', $fCode) . $data; - - my $frame; - my $packedId = pack ('C', $reqId); - - if ($proto eq "RTU") { # frame format: ID, (fCode, data), CRC - my $crc = pack ('v', Modbus_CRC($packedId . $pdu)); - $frame = $packedId . $pdu . $crc; - } elsif ($proto eq "ASCII") { # frame format: ID, (fCode, data), LRC - my $lrc = uc(unpack ('H2', pack ('v', Modbus_LRC($packedId.$pdu)))); - #Log3 $name, 5, "$name: LRC: $lrc"; - $frame = ':' . uc(unpack ('H2', $packedId) . unpack ('H*', $pdu)) . $lrc . "\r\n"; - } elsif ($proto eq "TCP") { # frame format: tid, 0, len, ID, (fCode, data) - my $dlen = bytes::length($pdu)+1; # length of pdu + Id - my $header = pack ('nnnC', ($tid, 0, $dlen, $reqId)); - $frame = $header.$pdu; - } - - $request->{FRAME} = $frame; # frame as data string for echo detection - $ioHash->{REQUEST} = $request; # save for later - - Modbus_Profiler($ioHash, "Send"); - $ioHash->{REQUESTHEX} = unpack ('H*', $frame); # for debugging / log - $ioHash->{BUSY} = 1; # modbus bus is busy until response is received - $ioHash->{helper}{buffer} = ""; # clear Buffer for reception - - #Log3 $name, 3, "$name: insert Garbage for testing"; - #$ioHash->{helper}{buffer} = pack ("C",0); # test / debug / todo: remove - - Log3 $name, 4, "$name: HandleSendQueue sends fc $fCode to id $reqId, tid $tid for $reading ($type$adr), len $len" . - ", device $logHash->{NAME} ($proto), pdu " . unpack ('H*', $pdu) . ", V $Modbus_Version"; - - DevIo_SimpleWrite($ioHash, $frame, 0); - - $now = gettimeofday(); - $ioHash->{helper}{lsend} = $now; # remember when last send to this bus - $logHash->{helper}{lsend} = $now; # remember when last send to this device - $ioHash->{helper}{lid} = $reqId; # device id we talked to - - Modbus_Statistics($ioHash, "Requests", 1); - Modbus_Profiler($ioHash, "Wait"); - my $timeout = ModbusLD_DevInfo($logHash, "timing", "timeout", 2); - my $toTime = $now+$timeout; - RemoveInternalTimer ("timeout:$name"); - InternalTimer($toTime, "Modbus_TimeoutSend", "timeout:$name", 0); - $ioHash->{nextTimeout} = $toTime; - - shift(@{$queue}); # remove first element from queue - if(@{$queue} > 0) { # more items in queue -> schedule next handle - InternalTimer($now+$queueDelay, "Modbus_HandleSendQueue", "queue:$name", 0); - } - return; -} - - - -################################################## -# -# Funktionen für logische Geräte -# zum Aufruf aus anderen Modulen -# -################################################## - - ##################################### sub ModbusLD_Initialize($ ) { @@ -1434,6 +449,7 @@ sub ModbusLD_Initialize($ ) "obj-[cdih][0-9]+-format " . "obj-[ih][0-9]+-type " . "obj-[cdih][0-9]+-showGet " . + "obj-[cdih][0-9]+-allowWrite " . "obj-[cdih][0-9]+-poll " . "obj-[cdih][0-9]+-polldelay "; @@ -1444,6 +460,8 @@ sub ModbusLD_Initialize($ ) "dev-([cdih]-)*write " . "dev-([cdih]-)*combine " . "dev-([cdih]-)*allowShortResponses " . + "dev-([cdih]-)*addressErrCode " . + "dev-([cdih]-)*valueErrCode " . "dev-([cdih]-)*defRevRegs " . "dev-([cdih]-)*defBswapRegs " . @@ -1452,9 +470,11 @@ sub ModbusLD_Initialize($ ) "dev-([cdih]-)*defDecode " . "dev-([cdih]-)*defEncode " . "dev-([cdih]-)*defExpr " . + "dev-([cdih]-)*defSetexpr " . "dev-([cdih]-)*defIgnoreExpr " . "dev-([cdih]-)*defFormat " . "dev-([cdih]-)*defShowGet " . + "dev-([cdih]-)*defAllowWrite " . "dev-([cdih]-)*defPoll " . "dev-h-brokenFC3 " . "dev-c-brokenFC5 " . @@ -1470,244 +490,315 @@ sub ModbusLD_Initialize($ ) "dev-type-[A-Za-z0-9_]+-map " . "dev-timing-timeout " . + "dev-timing-serverTimeout " . "dev-timing-sendDelay " . "dev-timing-commDelay "; return; } -##################################### -sub ModbusLD_SetIODev($) +################################################# +# Define für das physische serielle Basismodul. +# modbus id, Intervall etc. gibt es hier nicht +# sondern im logischen Modul. +# +# entsprechend wird auch getUpdate im +# logischen Modul aufgerufen. +# +# Modbus over TCP is opened in the logical open +# +sub Modbus_Define($$) { - my ($hash) = @_; - my $name = $hash->{NAME}; - my $ioName = AttrVal($name, "IODev", ""); - my $ioHash; - if ($ioName) { - # handle IODev Attribute - if ($defs{$ioName}) { # gibt es den Geräte-Hash zum IODev Attribut? - $ioHash = $defs{$ioName}; - } else { - Log3 $name, 3, "$name: SetIODev can't use $ioName from IODev attribute - device does not exist"; - } - } - if (!$ioHash) { - # search for usable physical Modbus device - for my $p (sort { $defs{$b}{NR} <=> $defs{$a}{NR} } keys %defs) { - if ( $defs{$p}{TYPE} eq "Modbus") { - $ioHash = $defs{$p}; - $attr{$name}{IODev} = $ioHash->{NAME}; # set IODev attribute - last; - } - } - } - if (!$ioHash) { - # still nothing found -> give up for now - Log3 $name, 3, "$name: SetIODev found no physical modbus device"; - return undef; - } - $ioName = $ioHash->{NAME}; - Log3 $name, 3, "$name: SetIODev registers $name with Id $hash->{MODBUSID} at $ioName"; - $hash->{IODev} = $ioHash; # point internal IODev to io device hash - $hash->{IODev}{defptr}{$hash->{MODBUSID}} = $hash; # register device for given id at io hash (for removal at undef) - Log3 $name, 5, "$name: SetIODev is using $ioHash->{NAME}"; - return $ioHash; + my ($ioHash, $def) = @_; + my @a = split("[ \t]+", $def); + my ($name, $type, $dev) = @a; + + return "wrong syntax: define $type [tty-devicename|none]" + if(@a < 3 || @a > 3); + + $ioHash->{DeviceName} = $dev; # needed by DevIo to get Device, Port, Speed etc. + $ioHash->{IODev} = $ioHash; # point back to self to make getIOHash easier + $ioHash->{SerialConn} = 1; + + Modbus_Close($ioHash, 1); # close, set Expect, clear Buffer, but don't set state to disconnected + + Log3 $name, 3, "$name: defined as $dev"; + return; # open is done later from NOTIFY } -######################################################################### -# set internal Timer to call GetUpdate if necessary -# either at next interval -# or if start is passed in start seconds (e.g. 2 seconds after Fhem init) -sub ModbusLD_SetTimer($;$) -{ - my ($hash, $start) = @_; - my $nextTrigger; - my $name = $hash->{NAME}; - my $now = gettimeofday(); - $start = 0 if (!$start); - - if ($hash->{INTERVAL} && $hash->{INTERVAL} > 0) { - if ($hash->{TimeAlign}) { - my $count = int(($now - $hash->{TimeAlign} + $start) / $hash->{INTERVAL}); - my $curCycle = $hash->{TimeAlign} + $count * $hash->{INTERVAL}; - $nextTrigger = $curCycle + $hash->{INTERVAL}; - } else { - $nextTrigger = $now + ($start ? $start : $hash->{INTERVAL}); - } - - $hash->{TRIGGERTIME} = $nextTrigger; - $hash->{TRIGGERTIME_FMT} = FmtDateTime($nextTrigger); - RemoveInternalTimer("update:$name"); - InternalTimer($nextTrigger, "ModbusLD_GetUpdate", "update:$name", 0); - Log3 $name, 4, "$name: update timer modified: will call GetUpdate in " . - sprintf ("%.1f", $nextTrigger - $now) . " seconds at $hash->{TRIGGERTIME_FMT} - Interval $hash->{INTERVAL}"; - } else { - $hash->{TRIGGERTIME} = 0; - $hash->{TRIGGERTIME_FMT} = ""; - } - return; -} - - -##################################### -sub Modbus_OpenCB($$) -{ - my ($hash, $msg) = @_; - my $name = $hash->{NAME}; - if ($msg) { - Log3 $name, 5, "$name: Open callback: $msg" if ($msg); - } - delete $hash->{BUSY_OPENDEV}; - delete $hash->{TIMEOUTS} if ($hash->{FD}); - return; -} - - ##################################### sub ModbusLD_Define($$) { my ($hash, $def) = @_; - my @a = split("[ \t]+", $def); - my ($name, $module, $id, $interval, $dest, $proto) = @a; + my ($name, $module, $id, $interval, $mode, $dest, $proto, $relay); - return "wrong syntax: define $module [id] [interval] [host:port] [RTU|ASCII|TCP]" - if(@a < 2); - - if ($proto) { - $proto = uc($proto); - return "wrong syntax: define $module [id] [interval] [host:port] [RTU|ASCII|TCP]" - if ($proto !~ /RTU|ASCII|TCP/); - } else { - if ($dest && uc($dest) =~ /RTU|ASCII|TCP/) { - # no host but protocol given - $proto = uc($dest); - $dest = ""; + # name modul id + my $sR = qr/(\S+)\s+(\S+)\s+(\d+)\s+/; + # destination aber nicht RTU etc. + my $dR = qr/(?:\s+(?!(?:RTU|ASCII|TCP))(\S+))?/; + # protocol + my $pR = qr/(?:\s+(RTU|ASCII|TCP))?/; + + # interv + if ($def =~ /${sR}(\d\.?\d*)${dR}${pR}\s*$/) { + # classic master define + ($name, $module, $id, $interval, $dest, $proto) = ($1, $2, $3, $4, $5, $6); + $mode = 'master'; + $interval = 0 if (!defined($interval)); + Log3 $name, 3, "$name: defined with id $id, interval $interval, protocol " . + ($proto ? $proto : "default (RTU)") . ", mode $mode" . + ($dest ? ", connection to $dest" : ""); + } elsif ($def =~ /${sR}(slave|passive)${dR}${pR}\s*$/) { + # classic slave or passive define + ($name, $module, $id, $mode, $dest, $proto) = ($1, $2, $3, $4, $5, $6); + $interval = 0; + if ($mode eq 'passive' && $dest) { + Log3 $name, 3, "$name: define as passive is only possible for serial connections, not with a defined host:port"; + return "Define as passive is only possible for serial connections, not with a defined host:port"; } + Log3 $name, 3, "$name: defined with id $id, protocol " . + ($proto ? $proto : "default (RTU)") . ", mode $mode" . + ($dest ? ", listening at $dest" : ""); + } elsif ($def =~ /${sR}(relay)${dR}${pR}\s+to\s+(\S+)$/) { + # relay define + ($name, $module, $id, $mode, $dest, $proto, $relay) = ($1, $2, $3, $4, $5, $6, $7); + $interval = 0; + Log3 $name, 3, "$name: defined with id $id, interval $interval, protocol " . + ($proto ? $proto : "default (RTU)") . ", mode $mode" . + ($dest ? ", listening at $dest" : "") . + " and relay to device $relay"; + } else { + ($name, $module) = ($def =~ /(\S+)\s+(\S+)\s+.*/); + return "Usage: define $module |slave|relay|passive [host:port] [RTU|ASCII|TCP] [to ]" } - + $proto = "RTU" if (!$proto); + + # for Modbus TCP physical = logical so IODev and MODE is set. + # for Modbus over serial lines this is set when IODev Attr 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 # but some gateways may use it to select the device to forward to. - - $id = 1 if (!defined($id)); - $interval = 0 if (!defined($interval)); - $proto = "RTU" if (!defined($proto)); - $dest = "" if (!defined($dest)); - - return "Interval has to be numeric" if ($interval !~ /[0-9.]+/); - $hash->{NOTIFYDEV} = "global"; # NotifyFn nur aufrufen wenn global events (INITIALIZED etc.) - $hash->{ModuleVersion} = $Modbus_Version; $hash->{MODBUSID} = $id; - $hash->{INTERVAL} = $interval; + $hash->{MODE} = $mode; $hash->{PROTOCOL} = $proto; + $hash->{INTERVAL} = $interval if ($interval); + $hash->{RELAY} = $relay if ($relay); $hash->{'.getList'} = ""; $hash->{'.setList'} = ""; $hash->{".updateSetGet"} = 1; + $hash->{STATE} = "disconnected"; # initial value + $hash->{NOTIFYDEV} = "global"; # NotifyFn nur aufrufen wenn global events (INITIALIZED etc.) + $hash->{MODULEVERSION} = "Modbus $Modbus_Version"; - if ($dest) { # Modbus über TCP mit IP Adresse angegeben (TCP oder auch RTU/ASCII über TCP) + if ($dest) { # Modbus über TCP mit IP Adresse (TCP oder auch RTU/ASCII über TCP) $dest .= ":502" if ($dest !~ /.*:[0-9]/); # add default port if no port specified - $hash->{DEST} = $dest; - $hash->{IODev} = $hash; # Modul ist selbst IODev - $hash->{defptr}{$id} = $hash; # ID verweist zurück auf eigenes Modul $hash->{DeviceName} = $dest; # needed by DevIo to get Device, Port, Speed etc. - $hash->{STATE} = "disconnected"; # initial value - + $hash->{IODev} = $hash; # Modul ist selbst IODev + $hash->{defptr}{$name} = $id; # logisches Gerät für die Id (eigenes Device bei TCP) + $hash->{TCPConn} = 1; + $hash->{TCPServer} = 1 if ($mode eq 'slave' || $mode eq 'relay'); my $modHash = $modules{$hash->{TYPE}}; $modHash->{AttrList} .= $Modbus_PhysAttrs; # affects all devices - even non TCP - sorry ... #Log3 $name, 3, "$name: added attributes for physical devices for Modbus TCP"; } else { - $hash->{DEST} = ""; # logical device that uses a physical Modbus device - } - Log3 $name, 3, "$name: defined with id $id, interval $interval, protocol $proto" . - ($dest ? ", destination $dest" : ""); + $dest = ''; + delete $hash->{TCPConn}; + delete $hash->{TCPServer}; + delete $hash->{TCPChild}; + } + # connection will be opened later in NotifyFN + # for serial connections we use a separate physical device. This is set in Notify + return; } + +##################################### +# delete physical Device +sub Modbus_Undef($$) +{ + my ($ioHash, $arg) = @_; + my $name = $ioHash->{NAME}; + + Modbus_Close($ioHash,1 ,1) if (DevIo_IsOpen($ioHash)); # close, set Expect, clear Buffer, don't set state, don't delete yet + + # lösche auch die Verweise aus logischen Modulen auf dieses physische. + foreach my $d (keys %{$ioHash->{defptr}}) { + Log3 $name, 3, "$name: Undef is removing IO device for $d"; + my $lHash = $defs{$d}; + delete $lHash->{IODev} if ($lHash); + ModbusLD_StopUpdateTimer($ioHash); # in case this is a TCP connected device + } + #Log3 $name, 3, "$name: _UnDef done"; + return; +} + + + +##################################### +sub ModbusLD_Undef($$) +{ + my ($hash, $arg) = @_; + my $name = $hash->{NAME}; + Log3 $name, 3, "$name: _UnDef is closing $name"; + ModbusLD_UnregAtIODev($hash); + Modbus_Close($hash,1 ,1) if (DevIo_IsOpen($hash)); # close, set Expect, clear Buffer, don't set state, don't delete yet + ModbusLD_StopUpdateTimer($hash); # in case this is a TCP connected device + delete $hash->{PROTOCOL}; # just in case somebody keeps a pointer to our hash ... + delete $hash->{MODE}; + return; +} + + + ######################################################################### +sub Modbus_ManageUserAttr($$) +{ + my ($hash, $aName) = @_; + my $name = $hash->{NAME}; + my $modHash = $modules{$hash->{TYPE}}; + + # handle wild card attributes -> Add to userattr to allow modification in fhemweb + if (" $modHash->{AttrList} " !~ m/ ${aName}[ :;]/) { + # nicht direkt in der Liste -> evt. wildcard attr in AttrList + foreach my $la (split " ", $modHash->{AttrList}) { + $la =~ /([^:;]+)(:?.*)/; + my $vgl = $1; # attribute name in list - probably a regex + my $opt = $2; # attribute hint in list + if ($aName =~ $vgl) { # yes - the name in the list now matches as regex + # $aName ist eine Ausprägung eines wildcard attrs + addToDevAttrList($name, "$aName" . $opt); # create userattr with hint to allow change in fhemweb + if ($opt) { + # remove old entries without hint + my $ualist = $attr{$name}{userattr}; + $ualist = "" if(!$ualist); + my %uahash; + foreach my $a (split(" ", $ualist)) { + if ($a !~ /^${aName}$/) { # entry in userattr list is attribute without hint + $uahash{$a} = 1; + } else { + Log3 $name, 3, "$name: added hint $opt to attr $a in userattr list"; + } + } + $attr{$name}{userattr} = join(" ", sort keys %uahash); + } + } + } + } else { + # exakt in Liste enthalten -> sicherstellen, dass keine +* etc. drin sind. + if ($aName =~ /\|\*\+\[/) { + Log3 $name, 3, "$name: Atribute $aName is not valid. It still contains wildcard symbols"; + return "$name: Atribute $aName is not valid. It still contains wildcard symbols"; + } + } +} + + + + +######################################################################### +# AttrFn for physical device. +# special treatment only für attr disable. +# sub Modbus_Attr(@) { my ($cmd,$name,$aName,$aVal) = @_; my $hash = $defs{$name}; # hash des physischen Devices - Log3 $name, 5, "$name: $cmd attr $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 # disable on a physical serial device if ($cmd eq "set" && $aVal) { - Log3 $name, 3, "$name: disable attribute set" . ($hash->{FD} ? ", closing connection" : ""); - DevIo_CloseDev($hash) if ($hash->{FD}); - $hash->{STATE} = "disconnected"; - $hash->{BUSY} = 0; + Log3 $name, 3, "$name: attr disable set" . (DevIo_IsOpen($hash) ? ", closing connection" : ""); + Modbus_Close($hash); # close, set Expect, clear Buffer, set state to disconnected } elsif ($cmd eq "del" || ($cmd eq "set" && !$aVal)) { - Log3 $name, 3, "$name: disable attribute removed"; - Modbus_Open($hash); + Log3 $name, 3, "$name: attr disable removed"; + Modbus_Open($hash); } } return undef; } - +# todo: when changing server-timeout -> reset internal timer ######################################################################### +# AttrFn for logical device. sub ModbusLD_Attr(@) { my ($cmd,$name,$aName,$aVal) = @_; my $hash = $defs{$name}; # hash des logischen Devices my $inCheckEval = 0; - # todo: validate other attrs - # e.g. unpack not allowed for coils / discrete inputs, len not for coils, - # max combine, etc. - # if ($cmd eq "set") { if ($aName =~ "expr") { # validate all Expressions my $val = 1; - eval $aVal; - if ($@) { - Log3 $name, 3, "$name: Attr with invalid Expression in attr $name $aName $aVal: $@"; - return "Invalid Expression $aVal"; - } - } elsif ($aName eq "IODev") { # defptr housekeeping - my $ioHash = $defs{$aVal}; - if ($ioHash && $ioHash->{TYPE} eq "Modbus") { # gibt es den Geräte-Hash zum IODev Attribut? - $ioHash->{defptr}{$hash->{MODBUSID}} = $hash; # register logical device - Log3 $name, 5, "$name: Attr IODev - using $aVal"; + my @val = (0,0,0,0,0,0); + if ($aVal !~ /readingsBulkUpdate/) { # dont even try if it contains this command + eval $aVal; + if ($@) { + Log3 $name, 3, "$name: attr with invalid Expression in attr $name $aName $aVal: $@"; + return "Invalid Expression $aVal"; + } } else { - Log3 $name, 5, "$name: Attr IODev can't use $aVal - device does not exist (yet?) or is not a physical Modbus Device"; - } + Log3 $name, 5, "$name: attr $name $aName $aVal is not checked now because it contains readingsBulkUpdate"; + } + } elsif ($aName eq "IODev") { + if ($hash->{TCPConn}) { + return "Attr IODev is not allowed for devices connected through TCP"; + } + if (!ModbusLD_SetIODev($hash, $aVal) && $init_done) { # set physical device proto, mode, register/unregister, ... + return "$aVal can not be used as IODev, see log for details"; + } + } elsif ($aName eq 'alignTime') { my ($alErr, $alHr, $alMin, $alSec, undef) = GetTimeSpec($aVal); return "Invalid Format $aVal in $aName : $alErr" if ($alErr); my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(); $hash->{TimeAlign} = fhemTimeLocal($alSec, $alMin, $alHr, $mday, $mon, $year); $hash->{TimeAlignFmt} = FmtDateTime($hash->{TimeAlign}); - ModbusLD_SetTimer($hash); # change timer for alignment + ModbusLD_StartUpdateTimer($hash); # change / start timer for alignment } elsif (" $Modbus_PhysAttrs " =~ /\ $aName[: ]/) { - if (!$hash->{DEST}) { - Log3 $name, 3, "$name: attribute $aName is only valid for physical Modbus devices or Modbus TCP - please use this attribute for your physical IO device $hash->{IODev}{NAME}"; - return "attribute $aName is only valid for physical Modbus devices or Modbus TCP - please use this attribute for your physical IO device $hash->{IODev}{NAME}"; + if (!$hash->{TCPConn} && !$hash->{SerialConn}) { + Log3 $name, 3, "$name: attr $aName is only valid for physical Modbus devices or Modbus TCP - please use this attribute for your physical IO device" . ($hash->{IODev}{NAME} ? ' ' . $hash->{IODev}{NAME} : ""); + return "attribute $aName is only valid for physical Modbus devices or Modbus TCP - please use this attribute for your physical IO device" . ($hash->{IODev}{NAME} ? ' ' . $hash->{IODev}{NAME} : ""); } - } elsif ($aName =~ /(obj-[cdih])(0+([0-9]+))-/) { + } elsif ($aName =~ /(obj-[cdih])[0-9]+-reading/) { + return "unsupported character in reading name $aName ". + "(not A-Za-z/\\d_\\.-)" if(!goodReadingName($aName)); + } elsif ($aName eq "SSL") { + if (!$hash->{TCPConn}) { + Log3 $name, 3, "$name: attr $aName is only valid Modbus TCP slaves"; + return "attribute $aName is only valid for Modbus TCP slaves"; + } + TcpServer_SetSSL($hash); + if($hash->{CD}) { + my $ret = IO::Socket::SSL->start_SSL($hash->{CD}); + Log3 $name, 3, "$hash->{NAME} start_SSL: $ret" if($ret); + } + } + if ($aName =~ /(obj-[cdih])(0+([0-9]+))-/) { # leading zero in obj-Attr detected if (length($2) > 5) { - my $new = $1 . substr("00000", 5 - length ($3)) . $3; + my $new = $1 . substr("00000", 0, 5 - length ($3)) . $3; + Log3 $name, 3, "$name: attr $aName address is too long, shortened to $new ($2/$3)"; $aName = $new; - Log3 $name, 3, "$name: Address in attribute $aName too long, shortened to $new"; } if (!$hash->{LeadingZeros}) { $hash->{LeadingZeros} = 1; - Log3 $name, 3, "$name: Support for leading zeros in object addresses enabled. This might slow down the fhem modbus module a bit"; + Log3 $name, 3, "$name: attr support for leading zeros in object addresses enabled. This might slow down the fhem modbus module a bit"; } } - - addToDevAttrList($name, $aName); + Modbus_ManageUserAttr($hash, $aName); } elsif ($cmd eq "del") { - #Log3 $name, 5, "$name: del attribute $aName"; + #Log3 $name, 5, "$name: attr del $aName"; if ($aName =~ /obj-[cdih]0[0-9]+-/) { if (!(grep !/$aName/, grep (/obj-[cdih]0[0-9]+-/, keys %{$attr{$name}}))) { delete $hash->{LeadingZeros}; # no more leading zeros @@ -1718,50 +809,39 @@ sub ModbusLD_Attr(@) if ($aName eq 'disable' && $init_done) { # if not init_done, nothing to be done here (see NotifyFN) # disable on a logical device (not physical here!) - if ($cmd eq "set" && $aVal) { - if ($hash->{DEST}) { # Modbus TCP - Log3 $name, 3, "$name: disable attribute set" . - ($hash->{FD} ? ", closing TCP connection" : ""); - DevIo_CloseDev($hash) if ($hash->{FD}); - $hash->{BUSY} = 0; + if ($cmd eq "set" && $aVal) { # disable set + if ($hash->{TCPConn}) { # Modbus over TCP connection + Log3 $name, 3, "$name: attr disable set" . + (DevIo_IsOpen($hash) ? ", closing TCP connection" : ""); + Modbus_Close($hash); # close, set Expect, clear Buffer, set state to disconnected + } else { + ModbusLD_UnregAtIODev($hash); } - RemoveInternalTimer("update:$name"); + ModbusLD_StopUpdateTimer($hash); # in case this is logical or a TCP connected device } elsif ($cmd eq "del" || ($cmd eq "set" && !$aVal)) { - Log3 $name, 3, "$name: disable attribute removed" . - ($hash->{DEST} ? ", opening TCP connection" : ""); - if ($hash->{DEST}) { # Modbus TCP - Modbus_Open($hash); # should be called with hash of physical device but for TCP it's the same - } else { - my $ioHash = ModbusLD_GetIOHash($hash); - my $ioName = $ioHash->{NAME}; - if ($ioName) { + Log3 $name, 3, "$name: attr disable removed" . + ($hash->{TCPConn} ? ", opening TCP connection" : ""); + if ($hash->{TCPConn}) { # Modbus over TCP connection + Modbus_Open($hash); # should be called with hash of physical device but for TCP it's the same + } else { + ModbusLD_UnregAtIODev($hash); # cleanup + my $ioHash = ModbusLD_GetIOHash($hash); # get ioName for meaningful logging + if ($ioHash) { + ModbusLD_RegisterAtIODev($hash, $ioHash); + my $ioName = $ioHash->{NAME}; Log3 $name, 3, "$name: using $ioName for communication"; } else { Log3 $name, 3, "$name: no IODev for communication"; } } - ModbusLD_SetTimer($hash, 1); # first Update in 1 second or aligned if interval is defined + ModbusLD_StartUpdateTimer($hash, 1); # first Update in 1 second or aligned if interval is defined } } return; } -##################################### -sub ModbusLD_Undef($$) -{ - my ($hash, $arg) = @_; - my $name = $hash->{NAME}; - - DevIo_CloseDev($hash) if ($hash->{DEST}); # logical Device over TCP - no underlying physical Device - RemoveInternalTimer ("update:$name"); - RemoveInternalTimer ("timeout:$name"); - RemoveInternalTimer ("queue:$name"); - return; -} - - ##################################### sub ModbusLD_UpdateGetSetList($) { @@ -1770,48 +850,53 @@ sub ModbusLD_UpdateGetSetList($) my $modHash = $modules{$hash->{TYPE}}; my $parseInfo = $modHash->{parseInfo}; - if (AttrVal($name, "enableControlSet", undef)) { # spezielle Sets freigeschaltet? - $hash->{'.setList'} = "interval reread:noArg reconnect:noArg stop:noArg start:noArg "; - if ($hash->{PROTOCOL} =~ /RTU|ASCII/) { - $hash->{'.setList'} .= "scanModbusId "; + if (AttrVal($name, "enableControlSet", 1)) { # spezielle Sets freigeschaltet (since 4.0 1 by default) + if ($hash->{MODE} && $hash->{MODE} eq 'master') { + $hash->{'.setList'} = "interval reread:noArg reconnect:noArg stop:noArg start:noArg close:noArg saveAsModule "; + if ($hash->{PROTOCOL} =~ /RTU|ASCII/) { + $hash->{'.setList'} .= "scanModbusId "; + } + $hash->{'.setList'} .= "scanStop:noArg scanModbusObjects "; + } else { + $hash->{'.setList'} = "reconnect:noArg saveAsModule "; } - $hash->{'.setList'} .= "scanStop:noArg scanModbusObjects "; } else { $hash->{'.setList'} = ""; } $hash->{'.getList'} = ""; - - my @ObjList = keys (%{$parseInfo}); - foreach my $at (keys %{$attr{$name}}) { - if ($at =~ /^obj-(.*)-reading$/) { - push @ObjList, $1 if (!$parseInfo->{$1}); - } - } - #Log3 $name, 5, "$name: UpdateGetSetList full object list: " . join (" ", @ObjList); - foreach my $objCombi (sort @ObjList) { - my $reading = ModbusLD_ObjInfo($hash, $objCombi, "reading"); - my $showget = ModbusLD_ObjInfo($hash, $objCombi, "showGet", "defShowGet", 0); # default to 0 - my $set = ModbusLD_ObjInfo($hash, $objCombi, "set", 0); # default to 0 - my $map = ModbusLD_ObjInfo($hash, $objCombi, "map", "defMap"); - my $hint = ModbusLD_ObjInfo($hash, $objCombi, "hint"); - #my $type = substr($objCombi, 0, 1); - #my $adr = substr($objCombi, 1); - my $setopt; - $hash->{'.getList'} .= "$reading:noArg " if ($showget); # sichtbares get - - if ($set) { # gibt es für das Reading ein SET? - if ($map){ # ist eine Map definiert, aus der Hints abgeleitet werden können? - my $hl = $map; - $hl =~ s/([^ ,\$]+):([^ ,\$]+,?) ?/$2/g; - $setopt = $reading . ":$hl"; - } else { - $setopt = $reading; # nur den Namen für setopt verwenden. + if ($hash->{MODE} && $hash->{MODE} eq 'master') { + my @ObjList = keys (%{$parseInfo}); + foreach my $at (keys %{$attr{$name}}) { + if ($at =~ /^obj-(.*)-reading$/) { + push @ObjList, $1 if (!$parseInfo->{$1}); } - if ($hint){ # hints explizit definiert? (überschreibt evt. schon abgeleitete hints) - $setopt = $reading . ":" . $hint; + } + #Log3 $name, 5, "$name: UpdateGetSetList full object list: " . join (" ", @ObjList); + + foreach my $objCombi (sort @ObjList) { + my $reading = Modbus_ObjInfo($hash, $objCombi, "reading"); + my $showget = Modbus_ObjInfo($hash, $objCombi, "showGet", "defShowGet", 0); # default to 0 + my $set = Modbus_ObjInfo($hash, $objCombi, "set", 0); # default to 0 + my $map = Modbus_ObjInfo($hash, $objCombi, "map", "defMap"); + my $hint = Modbus_ObjInfo($hash, $objCombi, "hint"); + #my $type = substr($objCombi, 0, 1); + #my $adr = substr($objCombi, 1); + my $setopt; + $hash->{'.getList'} .= "$reading:noArg " if ($showget); # sichtbares get + + if ($set) { # gibt es für das Reading ein SET? + if ($map){ # ist eine Map definiert, aus der Hints abgeleitet werden können? + my $hl = Modbus_MapToHint($map); + $setopt = $reading . ":$hl"; + } else { + $setopt = $reading; # nur den Namen für setopt verwenden. + } + if ($hint){ # hints explizit definiert? (überschreibt evt. schon abgeleitete hints) + $setopt = $reading . ":" . $hint; + } + $hash->{'.setList'} .= "$setopt "; # Liste aller Sets inkl. der Hints nach ":" für Rückgabe bei Set ? } - $hash->{'.setList'} .= "$setopt "; # Liste aller Sets inkl. der Hints nach ":" für Rückgabe bei Set ? } } #Log3 $name, 5, "$name: UpdateSetList: setList=$hash->{'.setList'}"; @@ -1821,8 +906,6 @@ sub ModbusLD_UpdateGetSetList($) } - - ##################################### # Get Funktion für logische Geräte / Module sub ModbusLD_Get($@) @@ -1831,63 +914,158 @@ sub ModbusLD_Get($@) return "\"get $a[0]\" needs at least one argument" if(@a < 2); my $name = $hash->{NAME}; my $getName = $a[1]; - - my $objCombi; - if ($getName ne "?") { - $objCombi = ModbusLD_ObjKey($hash, $getName); - #Log3 $name, 5, "$name: Get: key for $getName = $objCombi"; - } + my $async = AttrVal($name, "nonPrioritizedGet", 0); + my $err; + + my $objCombi = Modbus_ObjKey($hash, $getName); + Log3 $name, 5, "$name: get called with $getName " . ($objCombi ? "($objCombi)" : "") if ($getName ne "?"); if (!$objCombi) { ModbusLD_UpdateGetSetList($hash) if ($hash->{".updateSetGet"}); - Log3 $name, 5, "$name: Get: $getName not found, return list $hash->{'.getList'}" - if ($getName ne "?"); + #Log3 $name, 5, "$name: get $getName not found, return list $hash->{'.getList'}" if ($getName ne "?"); return "Unknown argument $a[1], choose one of $hash->{'.getList'}"; } - if (IsDisabled($name)) { - Log3 $name, 5, "$name: Get called with $getName but device is disabled"; - return undef; - } - my $ioHash = ModbusLD_GetIOHash($hash); - return undef if (!$ioHash); - - my ($err, $result); - Log3 $name, 5, "$name: Get: Called with $getName ($objCombi)"; + my $msg = ModbusLD_GetSetChecks($hash, $async); + return $msg if ($msg); # no other action because io device is not usable anyway - if ($ioHash->{BUSY}) { # Answer for last function code has not yet arrived - Log3 $name, 5, "$name: Get: Queue is stil busy - taking over the read with ReadAnswer"; - - ModbusLD_ReadAnswer($hash); # finish last read and wait for the result before next request - Modbus_EndBUSY ($ioHash); # set BUSY to 0, delete REQUEST, clear Buffer, do Profilig + delete $hash->{gotReadings}; + if ($async) { + ModbusLD_DoRequest($hash, $objCombi, "read", 0, 0); # no force, just queue + } else { + ModbusLD_DoRequest($hash, $objCombi, "read", 0, 1); # add at beginning of queue and force send / sleep if necessary + $err = Modbus_ReadAnswer(ModbusLD_GetIOHash($hash)); # ioHash has been checked above already in GetSetChecks } - - ModbusLD_Send($hash, $objCombi, "read", 0, 1); # add at beginning of queue and force send / sleep if necessary - ($err, $result) = ModbusLD_ReadAnswer($hash, $getName); - Modbus_EndBUSY ($ioHash); # set BUSY to 0, delete REQUEST, clear Buffer, do Profilig - + Modbus_StartQueueTimer($hash, 0); # call processRequestQueue at next possibility (others waiting?) return $err if ($err); - return $result; + return $hash->{gotReadings}{$getName}; } -sub Modbus_compObjAttrs ($$) { - my ($a, $b) = @_; - my $aType = substr($a, 4, 1); - my $aStart = substr($a, 5); - my $bType = substr($b, 4, 1); - my $bStart = substr($b, 5); - my $result = ($aType cmp $bType); - if ($result) { - return $result; +##################################### +sub ModbusLD_Set($@) +{ + my ($hash, @a) = @_; + return "\"set $a[0]\" needs at least an argument" if(@a < 2); + + my ($name, $setName, @setValArr) = @a; + my $setVal = (@setValArr ? join(' ', @setValArr) : ""); + my $rawVal = ""; + my $async = AttrVal($name, "nonPrioritizedSet", 0); + + if (AttrVal($name, "enableControlSet", 1)) { # spezielle Sets freigeschaltet? + my $error = ModbusLD_ControlSet($hash, $setName, $setVal); + return if (defined($error) && $error eq "0"); # control set found and done. + return $error if ($error); # error + # continue if ControlSet function returned undef } - $result = $aStart <=> $bStart; - return $result; + + my $objCombi = Modbus_ObjKey($hash, $setName); + Log3 $name, 5, "$name: set called with $setName " . + ($objCombi ? "($objCombi) " : " ") . + (defined($setVal) ? "setVal = $setVal" :"") if ($setName ne "?"); + + if (!$objCombi) { + ModbusLD_UpdateGetSetList($hash) if ($hash->{".updateSetGet"}); + #Log3 $name, 5, "$name: set $setName not found, return list $hash->{'.setList'}" if ($setName ne "?"); + return "Unknown argument $a[1], choose one of $hash->{'.setList'}"; + } + if (!defined($setVal)) { + Log3 $name, 3, "$name: set without value for $setName"; + return "No Value given to set $setName"; + } + + my $msg = ModbusLD_GetSetChecks($hash, $async); + return $msg if ($msg); # no other action because io device is not usable anyway + + my $ioHash = ModbusLD_GetIOHash($hash); # ioHash has been checked in GetSetChecks above already + + my $map = Modbus_ObjInfo($hash, $objCombi, "map", "defMap"); + my $setmin = Modbus_ObjInfo($hash, $objCombi, "min", "", ""); # default to "" + my $setmax = Modbus_ObjInfo($hash, $objCombi, "max", "", ""); # default to "" + my $setexpr = Modbus_ObjInfo($hash, $objCombi, "setexpr", "defSetexpr"); + my $textArg = Modbus_ObjInfo($hash, $objCombi, "textArg"); + my $unpack = Modbus_ObjInfo($hash, $objCombi, "unpack", "defUnpack", "n"); + my $revRegs = Modbus_ObjInfo($hash, $objCombi, "revRegs", "defRevRegs"); + my $swpRegs = Modbus_ObjInfo($hash, $objCombi, "bswapRegs", "defBswapRegs"); + my $len = Modbus_ObjInfo($hash, $objCombi, "len", "defLen", 1); + + my $type = substr($objCombi, 0, 1); + my $fCode = Modbus_DevInfo($hash, $type, "write", $Modbus_defaultFCode{$type}{write}); + + # 1. Schritt: Map prüfen + if ($map) { + $rawVal = Modbus_MapConvert ($hash, $map, $setVal, 1); # use reversed map + return "set value $setVal did not match defined map" if (!defined($rawVal)); + Log3 $name, 5, "$name: set converted $setVal to $rawVal using map $map"; + } else { + $rawVal = $setVal; + } + + # 2. Schritt: falls definiert Min- und Max-Werte prüfen + if ($rawVal =~ /^\s*-?\d+\.?\d*\s*$/) { # a number (potentially with blanks) + $rawVal =~ s/\s+//g if (!$textArg); # remove blanks + if ($setmin ne "") { + Log3 $name, 5, "$name: set is checking value $rawVal against min $setmin"; + return "value $rawVal is smaller than min ($setmin)" if ($rawVal < $setmin); + } + if ($setmax ne "") { + Log3 $name, 5, "$name: set is checking value $rawVal against max $setmax"; + return "value $rawVal is bigger than max ($setmax)" if ($rawVal > $setmax); + } + } else { + if (!$textArg) { + Log3 $name, 3, "$name: set value $rawVal is not numeric and textArg not specified"; + return "Set Value $rawVal is not numeric and textArg not specified"; + } + } + + # 3. Schritt: Konvertiere mit setexpr falls definiert + my @val = ($rawVal); + $rawVal = Modbus_CheckEval($hash, @val, $setexpr, "setexpr for $setName") if ($setexpr); + + # 4. Schritt: Pack value + my $packedVal; + if ($fCode == 5) { # special treatment when writing one coil + if (Modbus_DevInfo($hash, "c", "brokenFC5", 0)) { + my $oneCode = lc Modbus_DevInfo($hash, "c", "brokenFC5"); + $packedVal = pack ('H4', ($rawVal ? $oneCode : "0000")); + } else { + $packedVal = pack ('H4', ($rawVal ? "FF00" : "0000")); + } + } else { + $packedVal = pack ($unpack, $rawVal); + } + Log3 $name, 5, "$name: set packed hex " . unpack ('H*', $rawVal) . " with $unpack to hex " . unpack ('H*', $packedVal); + + # 5. Schritt: RevRegs / SwapRegs if needed + $packedVal = Modbus_RevRegs($hash, $packedVal, $len) if ($revRegs && $len > 1); + $packedVal = Modbus_SwpRegs($hash, $packedVal, $len) if ($swpRegs); + + if ($async) { + ModbusLD_DoRequest($hash, $objCombi, "write", $packedVal, 0); # no force, just queue at the end + } else { + ModbusLD_DoRequest($hash, $objCombi, "write", $packedVal, 1); # add at beginning and force send / sleep if necessary + my $err = Modbus_ReadAnswer($ioHash); + return $err if ($err); + } + if ($fCode == 15 || $fCode == 16) { # read after write + Log3 $name, 5, "$name: set is sending read after write"; + if ($async) { + ModbusLD_DoRequest($hash, $objCombi, "read", 0, 0); # no force, just queue at the end + } else { + ModbusLD_DoRequest($hash, $objCombi, "read", 0, 1); # as 1st and force send / sleep if necessary + my $err = Modbus_ReadAnswer($ioHash); + return "$err (in read after write for FCode 16)" if ($err); + } + } + Modbus_StartQueueTimer($hash, 0); # call processRequestQueue at next possibility (others waiting?) + return; # no return code if no error } # -# SET command - handle predifined control sets +# SET command - handle predefined control sets ################################################ sub ModbusLD_ControlSet($$$) { @@ -1895,44 +1073,65 @@ sub ModbusLD_ControlSet($$$) my $name = $hash->{NAME}; if ($setName eq 'interval') { + return "set interval is only allowed when Fhem is Modbus master" if ($hash->{MODE} ne 'master'); if (!$setVal || $setVal !~ /[0-9.]+/) { - Log3 $name, 3, "$name: no valid interval (secs) specified in set, continuing with $hash->{INTERVAL} (sec)"; + Log3 $name, 3, "$name: set interval $setVal not valid, continuing with $hash->{INTERVAL} (sec)"; return "No valid Interval specified"; } else { $hash->{INTERVAL} = $setVal; - Log3 $name, 3, "$name: timer interval changed to $hash->{INTERVAL} seconds"; - ModbusLD_SetTimer($hash); + Log3 $name, 3, "$name: set interval changed interval to $hash->{INTERVAL} seconds"; + ModbusLD_StartUpdateTimer($hash); return "0"; } } elsif ($setName eq 'reread') { + return "set reread is only allowed when Fhem is Modbus master" if ($hash->{MODE} ne 'master'); ModbusLD_GetUpdate("reread:$name"); return "0"; - } elsif ($setName eq 'reconnect') { - if (IsDisabled($name)) { - Log3 $name, 3, "$name: set reconnect called but device is disabled"; - return "set reconnect called but device is disabled"; + } elsif ($setName eq 'reconnect') { + if (!$hash->{TCPConn} && $hash->{TYPE} ne 'Modbus') { + Log3 $name, 3, "$name: reconnect only possible for physical or TCP connections, not for logical devices"; + return "reconnect only possible for physical or TCP connections, not for logical devices"; } - if (!$hash->{DEST}) { - Log3 $name, 3, "$name: set reconnect called but device is not using Modbus TCP and the connection is going through another device so the connection can't be reconnected from here"; - return "set reconnect called but device is connecting through another physical device"; + # todo: close and immediate reopen might case problems on windows with usb device + # needs testing + + my $msg = ModbusLD_CheckDisable($hash); + return $msg if ($msg); + + Modbus_Open($hash, 0, 0, 1); # async but close first + return "0"; + + } elsif ($setName eq 'close') { + if (!$hash->{TCPConn} && $hash->{TYPE} ne 'Modbus') { + Log3 $name, 3, "$name: close only possible for physical or TCP connections, not for logical devices"; + return "close only possible for physical or TCP connections, not for logical devices"; } - Modbus_Open($hash); # should be called with hash of physical device but for TCP it's the same + Modbus_Close($hash); # should be called with hash of physical device but for TCP it's the same return "0"; } elsif ($setName eq 'stop') { - RemoveInternalTimer("update:$name"); - $hash->{TRIGGERTIME} = 0; - $hash->{TRIGGERTIME_FMT} = ""; - Log3 $name, 3, "$name: internal interval timer stopped"; + return "set stop is only allowed when Fhem is Modbus master" if ($hash->{MODE} ne 'master'); + ModbusLD_StopUpdateTimer($hash); return "0"; } elsif ($setName eq 'start') { - ModbusLD_SetTimer($hash); + my $msg = ModbusLD_CheckDisable($hash); + return $msg if ($msg); + + return "set start is only allowed when Fhem is Modbus master" if ($hash->{MODE} ne 'master'); + ModbusLD_StartUpdateTimer($hash); return "0"; } elsif ($setName eq 'scanStop') { + Log3 $name, 3, "$name: scanStop - try asyncOutput to $hash"; + my $cl = $hash->{CL}; + asyncOutput($cl, 'Hallo Du'); + + my $msg = ModbusLD_CheckDisable($hash); + return $msg if ($msg); + return "set scanStop is only allowed when Fhem is Modbus master" if ($hash->{MODE} ne 'master'); RemoveInternalTimer ("scan:$name"); delete $hash->{scanId}; delete $hash->{scanIdStart}; @@ -1945,6 +1144,9 @@ sub ModbusLD_ControlSet($$$) return "0"; } elsif ($setName eq 'scanModbusId') { + my $msg = ModbusLD_CheckDisable($hash); + return $msg if ($msg); + return "set scanModbusId is only allowed when Fhem is Modbus master" if ($hash->{MODE} ne 'master'); delete $hash->{scanOStart}; delete $hash->{scanOEnd}; $hash->{scanIdStart} = 1; @@ -1958,7 +1160,7 @@ sub ModbusLD_ControlSet($$$) $hash->{scanOType} = substr($3,0,1); $hash->{scanOAdr} = substr($3,1); } - Log3 $name, 3, "$name: Scan range specified as Modbus Id $hash->{scanIdStart} to $hash->{scanIdEnd}" . + Log3 $name, 3, "$name: set scan range specified as Modbus Id $hash->{scanIdStart} to $hash->{scanIdEnd}" . " with $hash->{scanOType}$hash->{scanOAdr}, Len "; delete $hash->{scanId}; @@ -1969,6 +1171,9 @@ sub ModbusLD_ControlSet($$$) return "0"; } elsif ($setName eq 'scanModbusObjects') { + my $msg = ModbusLD_CheckDisable($hash); + return $msg if ($msg); + return "set scanModbusObjects is only allowed when Fhem is Modbus master" if ($hash->{MODE} ne 'master'); delete $hash->{scanId}; delete $hash->{scanIdStart}; delete $hash->{scanIdEnd}; @@ -1982,7 +1187,7 @@ sub ModbusLD_ControlSet($$$) $hash->{scanOEnd} = $3; $hash->{scanOLen} = ($5 ? $5 : 1); } - Log3 $name, 3, "$name: Scan $hash->{scanOType} from $hash->{scanOStart} to $hash->{scanOEnd} len $hash->{scanOLen}"; + Log3 $name, 3, "$name: set scan $hash->{scanOType} from $hash->{scanOStart} to $hash->{scanOEnd} len $hash->{scanOLen}"; delete $hash->{scanOAdr}; my $now = gettimeofday(); @@ -1991,13 +1196,12 @@ sub ModbusLD_ControlSet($$$) InternalTimer($now+$scanDelay, "ModbusLD_ScanObjects", "scan:$name", 0); return "0"; } elsif ($setName eq 'saveAsModule') { - my $fName = $setVal; - + my $fName = $setVal; my $out; my $last = "x"; if (!open($out, ">", "/tmp/98_ModbusGen$fName.pm")) { - Log3 $name, 3, "$name: Cannot create output file $hash->{OUTPUT}"; + Log3 $name, 3, "$name: set saveAsModule cannot create output file $hash->{OUTPUT}"; return; }; @@ -2087,21 +1291,20 @@ sub ModbusGen${fName}_Initialize(\$) sub ModbusLD_ScanObjects($) { my $param = shift; my ($calltype,$name) = split(':',$param); - my $hash = $defs{$name}; # hash des logischen Devices, da GetUpdate aus dem logischen Modul per Timer gestartet wird - + my $hash = $defs{$name}; # hash des logischen Devices, da GetUpdate aus dem logischen Modul per Timer gestartet wird my $now = gettimeofday(); my $scanDelay = AttrVal($name, "scanDelay", 1); - my $ioHash = ModbusLD_GetIOHash($hash); + my $ioHash = ModbusLD_GetIOHash($hash); # get ioHash to check for full queue. It has been checked in GetSetChecks my $queue = $ioHash->{QUEUE}; my $qlen = ($ioHash->{QUEUE} ? scalar(@{$ioHash->{QUEUE}}) : 0); - + my $qMax = AttrVal($ioHash->{NAME}, "queueMax", AttrVal($name, "queueMax", 100)); RemoveInternalTimer ("scan:$name"); - if ($qlen && $qlen > AttrVal($name, "queueMax", 100) / 2) { + if ($qlen && $qlen > $qMax / 2) { InternalTimer($now+$scanDelay, "ModbusLD_ScanObjects", "scan:$name", 0); Log3 $name, 5, "$name: ScanObjects waits until queue gets smaller"; return; } - if ($hash->{scanOAdr} || $hash->{scanOAdr} eq "0") { + if (defined($hash->{scanOAdr})) { if ($hash->{scanOAdr} < $hash->{scanOEnd}) { $hash->{scanOAdr}++; } else { @@ -2115,7 +1318,7 @@ sub ModbusLD_ScanObjects($) { } else { $hash->{scanOAdr} = $hash->{scanOStart}; } - ModbusLD_Send ($hash, $hash->{scanOType}.$hash->{scanOAdr}, 'scanobj', 0, 0, $hash->{scanOLen}); + ModbusLD_DoRequest ($hash, $hash->{scanOType}.$hash->{scanOAdr}, 'scanobj', 0, 0, $hash->{scanOLen}); InternalTimer($now+$scanDelay, "ModbusLD_ScanObjects", "scan:$name", 0); return; } @@ -2129,14 +1332,13 @@ sub ModbusLD_ScanObjects($) { sub ModbusLD_ScanIds($) { my $param = shift; my ($calltype,$name) = split(':',$param); - my $hash = $defs{$name}; # hash des logischen Devices, da GetUpdate aus dem logischen Modul per Timer gestartet wird - + my $hash = $defs{$name}; # hash des logischen Devices, da GetUpdate aus dem logischen Modul per Timer gestartet wird my $now = gettimeofday(); my $scanDelay = AttrVal($name, "scanDelay", 1); - my $ioHash = ModbusLD_GetIOHash($hash); + my $ioHash = ModbusLD_GetIOHash($hash); # get ioHash to check for full queue. It has been checked in GetSetChecks my $queue = $ioHash->{QUEUE}; my $qLen = ($ioHash->{QUEUE} ? scalar(@{$ioHash->{QUEUE}}) : 0); - my $qMax = AttrVal($name, "queueMax", 100) / 2; + my $qMax = AttrVal($ioHash->{NAME}, "queueMax", AttrVal($name, "queueMax", 100)); RemoveInternalTimer ("scan:$name"); if ($qLen && $qLen > $qMax) { @@ -2160,7 +1362,7 @@ sub ModbusLD_ScanIds($) { } else { $hash->{scanId} = $hash->{scanIdStart}; } - ModbusLD_Send ($hash, $hash->{scanOType}.$hash->{scanOAdr}, 'scanid'.$hash->{scanId}, 0, 0, $hash->{scanOLen}); + ModbusLD_DoRequest ($hash, $hash->{scanOType}.$hash->{scanOAdr}, 'scanid'.$hash->{scanId}, 0, 0, $hash->{scanOLen}); InternalTimer($now+$scanDelay, "ModbusLD_ScanIds", "scan:$name", 0); return; } @@ -2177,7 +1379,7 @@ sub ModbusLD_ScanFormat($$) my $i = unpack("s", $val); my $n = unpack("S", $val); my $h = unpack("H*", $val); - Log3 $name, 5, "$name: ScanFormat: hex=$h, bytes=$len"; + Log3 $name, 5, "$name: ScanFormat hex=$h, bytes=$len"; my $ret = "hex=$h, string="; for my $c (split //, $val) { @@ -2212,296 +1414,2220 @@ sub ModbusLD_ScanFormat($$) } -##################################### -sub ModbusLD_Set($@) + +#################################################################################### +# Notify for INITIALIZED -> Open defined physical / logical (tcp) device +# both for physical and logical tcp connected devices +# +# Bei jedem Define erzeugt Fhem.pl ein $hash{NTFY_ORDER} für das +# Device falls im Modul eine NotifyFn gesetzt ist. +# +# bei jedem Define, Rename oder Modify wird der interne Hash %ntfyHash +# gelöscht und beim nächsten Event in createNtfyHash() neu erzeugt +# wenn er nicht existiert. +# +# Im %ntfyHash wird dann für jede mögliche Event-Quelle als Key auf die Liste +# der Event-Empfänger verwiesen. +# +# die createNtfyHash() Funktion schaut für jedes Device nach $hash{NOTIFYDEV} +# falls existent wird das Gerät nur für die in $hash{NOTIFYDEV} aufgelisteten +# Event-Erzeuger in deren ntfyHash-Eintrag es Evet-Empfänger aufgenommen. +# +# Um ein Gerät als Event-Empfänger aus den Listen mit Event-Empfängern zu entfernen +# könnte man $hash{NOTIFYDEV} auf "," setzen und %ntfyHash auf () löschen... +# +# im Modul die NotifyFn zu entfernen würde den Aufruf verhindern, aber +# $hash{NTFY_ORDER} bleibt und daher erzeugt auch createNtfyHash() immer wieder verweise +# auf das Gerät, obwohl die NotifyFn nicht mehr registriert ist ... +# +# +sub Modbus_Notify($$) { - my ($hash, @a) = @_; - return "\"set $a[0]\" needs at least an argument" if(@a < 2); + my ($hash, $source) = @_; + my $name = $hash->{NAME}; # my Name + my $sName = $source->{NAME}; # Name of Device that created the events + return if($sName ne "global"); # only interested in global Events - my ($name, $setName, @setValArr) = @a; - my $setVal = (@setValArr ? join(' ', @setValArr) : ""); - my $rawVal = ""; + my $events = deviceEvents($source, 1); + return if(!$events); # no events - if (AttrVal($name, "enableControlSet", undef)) { # spezielle Sets freigeschaltet? - my $error = ModbusLD_ControlSet($hash, $setName, $setVal); - return if (defined($error) && $error eq "0"); # control set found and done. - return $error if ($error); # error - # continue if function returned undef - } + #Log3 $name, 5, "$name: Notify called for source $source->{NAME} with events: @{$events}"; + return if (!grep(m/^INITIALIZED|REREADCFG|(MODIFIED $name)$|(DEFINED $name)$/, @{$events})); + # DEFINED is not triggered if init is not done. - my $objCombi; - if ($setName ne "?") { - $objCombi = ModbusLD_ObjKey($hash, $setName); - #Log3 $name, 5, "$name: Set: key for $setName = $objCombi"; - } - - if (!$objCombi) { - ModbusLD_UpdateGetSetList($hash) if ($hash->{".updateSetGet"}); - Log3 $name, 5, "$name: Set: $setName not found, return list $hash->{'.setList'}" - if ($setName ne "?"); - return "Unknown argument $a[1], choose one of $hash->{'.setList'}"; - } - if (IsDisabled($name)) { - Log3 $name, 4, "$name: set called with $setName but device is disabled"; + Log3 $name, 3, "$name: Notify / Init: device is disabled"; return; } - - my $ioHash = ModbusLD_GetIOHash($hash); # get or reconstruct ioHash. reconnecton is done in Queue handling if necessary - return if (!$ioHash); - my $type = substr($objCombi, 0, 1); - my ($err,$result); - - # todo: noarg checking? - if (!defined($setVal)) { - Log3 $name, 3, "$name: No Value given to set $setName"; - return "No Value given to set $setName"; - } - Log3 $name, 5, "$name: Set called with $setName ($objCombi), setVal = $setVal"; - - if ($ioHash->{BUSY}) { - Log3 $name, 5, "$name: Set: Queue still busy - taking over the read with ReadAnswer"; - # Answer for last function code has not yet arrived - ModbusLD_ReadAnswer($hash); # finish last read and wait for the result before next request - Modbus_EndBUSY ($ioHash); # set BUSY to 0, delete REQUEST, clear Buffer, do Profilig - } - my $map = ModbusLD_ObjInfo($hash, $objCombi, "map", "defMap"); - my $setmin = ModbusLD_ObjInfo($hash, $objCombi, "min", "", ""); # default to "" - my $setmax = ModbusLD_ObjInfo($hash, $objCombi, "max", "", ""); # default to "" - my $setexpr = ModbusLD_ObjInfo($hash, $objCombi, "setexpr"); - my $textArg = ModbusLD_ObjInfo($hash, $objCombi, "textArg"); - my $unpack = ModbusLD_ObjInfo($hash, $objCombi, "unpack", "defUnpack", "n"); - my $revRegs = ModbusLD_ObjInfo($hash, $objCombi, "revRegs", "defRevRegs"); - my $swpRegs = ModbusLD_ObjInfo($hash, $objCombi, "bswapRegs", "defBswapRegs"); - my $len = ModbusLD_ObjInfo($hash, $objCombi, "len", "defLen", 1); - - my $fCode = ModbusLD_DevInfo($hash, $type, "write", $Modbus_defaultFCode{$type}{write}); - - if ($map) { # 1. Schritt: Map prüfen - my $rm = $map; - $rm =~ s/([^ ,\$]+):([^ ,\$]+),? ?/$2 $1 /g; # reverse map string erzeugen - my %rmap = split (' ', $rm); # reverse hash aus dem reverse string - if (defined($rmap{$setVal})) { # reverse map Eintrag für das Reading und den Wert definiert - $rawVal = $rmap{$setVal}; - Log3 $name, 5, "$name: Set: found $setVal in map and converted to $rawVal"; - } else { # Wert nicht in der Map - Log3 $name, 3, "$name: Set: Value $setVal did not match defined map"; - return "Set Value $setVal did not match defined map"; - } - } else { - $rawVal = $setVal; - } - - if ($rawVal =~ /^\s*-?\d+\.?\d*\s*$/) { # a number (potentially with blanks) - $rawVal =~ s/\s+//g if (!$textArg); # remove blanks - if ($setmin ne "") { # 2. Schritt: falls definiert Min- und Max-Werte prüfen - Log3 $name, 5, "$name: Set: checking value $rawVal against min $setmin"; - return "value $rawVal is smaller than min ($setmin)" if ($rawVal < $setmin); - } - if ($setmax ne "") { - Log3 $name, 5, "$name: Set: checking value $rawVal against max $setmax"; - return "value $rawVal is bigger than max ($setmax)" if ($rawVal > $setmax); - } - } else { - if (!$textArg) { - Log3 $name, 3, "$name: Set: Value $rawVal is not numeric and textArg not specified"; - return "Set Value $rawVal is not numeric and textArg not specified"; - } - } - - # 3. Schritt: Konvertiere mit setexpr falls definiert - $rawVal = Modbus_CheckEval($hash, $rawVal, $setexpr, "Set", "setexpr for $setName") if ($setexpr); + # physical device or TCP - open connection here + if ($hash->{TYPE} eq "Modbus" || $hash->{TCPConn}) { # physical device or Modbus TCP -> call open (even for slave) + Log3 $name, 4, "$name: Notify / Init: opening connection"; + Modbus_Open($hash); # connection or listening socket for tcp slave - my $packedVal = pack ($unpack, $rawVal); - Log3 $name, 5, "$name: set packed hex " . unpack ('H*', $rawVal) . " with $unpack to hex " . unpack ('H*', $packedVal); - $packedVal = Modbus_RevRegs($hash, $packedVal, $len) if ($revRegs && $len > 1); - $packedVal = Modbus_SwpRegs($hash, $packedVal, $len) if ($swpRegs); - - if (AttrVal($name, "nonPrioritizedSet", 0)) { - ModbusLD_Send($hash, $objCombi, "write", $packedVal, 0); # no force, just queue - } else { - ModbusLD_Send($hash, $objCombi, "write", $packedVal, 1); # add at beginning and force send / sleep if necessary - ($err, $result) = ModbusLD_ReadAnswer($hash, $setName); - Modbus_EndBUSY ($ioHash); # set BUSY to 0, delete REQUEST, clear Buffer, do Profilig - return $err if ($err); - } - - if ($fCode == 15 || $fCode == 16) { - # read after write - Log3 $name, 5, "$name: Set: sending read after write"; - - if (AttrVal($name, "nonPrioritizedSet", 0)) { - ModbusLD_Send($hash, $objCombi, "read", 0, 0); # no force, just queue + } else { # logical device and not Modbus TCP -> check for IO Device + ModbusLD_UnregAtIODev($hash); # first unregster / cleanup potential old and wrong registrations and locks + delete $hash->{IODev}; # force call to setIODev and set state to opened + my $ioHash = ModbusLD_GetIOHash($hash); + if ($ioHash) { + Log3 $name, 3, "$name: Notify / Init: using $ioHash->{NAME} for communication"; + #ModbusLD_RegisterAtIODev($hash, $ioHash); # no need to call this - already done when calling GetIOHash ... } else { - ModbusLD_Send($hash, $objCombi, "read", 0, 1); # add at beginning and force send / sleep if necessary - ($err, $result) = ModbusLD_ReadAnswer($hash, $setName); - Modbus_EndBUSY ($ioHash); # set BUSY to 0, delete REQUEST, clear Buffer, do Profilig - return "$err (in read after write for FCode 16)" if ($err); + Log3 $name, 3, "$name: Notify / Init: no IODev for communication"; + # continue anyway - maybe we'll have an iodev later } } - return; # no return code if no error + # logical device going through an IO Device + if ($hash->{TYPE} ne "Modbus" && $hash->{MODE} eq 'master') { + ModbusLD_StartUpdateTimer($hash, 1); # logical device -> first Update in 1 second or aligned if interval is defined + + # relay device to communicate through + } elsif ($hash->{MODE} && $hash->{MODE} eq 'relay') { # Mode relay -> find / check relay device + my $reName = $hash->{RELAY}; + my $reIOHash = Modbus_GetRelayIO($hash); + if ($reIOHash) { + Log3 $name, 3, "$name: Notify / Init: using $reName as Modbus relay device"; + } else { + Log3 $name, 3, "$name: Notify / Init: no relay device for communication ($reName must be a modbus master)"; + } + } + #Log3 $name, 3, "$name: _Notify done"; + return; } -############################################### -# Called from get / set to get a direct answer -# called with logical device hash -# has to return a value and an error separately -# so set can ignore the value and only return an error -# whereas get needs the value or error -sub ModbusLD_ReadAnswer($;$) +########################### +# open connection +# $hash is physical or both (connection over TCP) +# called from set reconnect, Attr / LDAttr (disable), +# Notify (initialized, rereadcfg, |(MODIFIED $name)), +# Ready, ProcessRequestQueue and GetSetChecks +sub Modbus_Open($;$$$) { - my ($hash, $reading) = @_; - my $name = $hash->{NAME}; - my $now = gettimeofday(); + my ($hash, $ready, $force, $closeFirst) = @_; + my $name = $hash->{NAME}; + my $now = gettimeofday(); + my $caller = Modbus_Caller(); + $ready = 0 if (!$ready); + + if (!$hash->{TCPConn} && $hash->{TYPE} ne 'Modbus') { + Log3 $name, 3, "$name: open called from $caller for logical device - this should not happen"; + return; + } + if ($hash->{TCPChild}) { + Log3 $name, 3, "$name: open called for a TCP Child hash - this should not happen"; + return; + } + if ($hash->{TCPServer}) { + # Modbus slave or relay over TCP connection -> open listening port + Log3 $name, 5, "$name: Open called for listening to a TCP connection"; + if ($closeFirst && $hash->{FD}) { # DevIo_IsOpen($hash) doesn't work for TCP server + Modbus_Close($hash, 1); # close, set Expect, clear Buffer, don't set state + } + my ($dest, $port) = split("[: \t]+", $hash->{DeviceName}); + my $ret = TcpServer_Open($hash, $port, $dest); + if ($ret) { + Log3 $name, 3, "$name: TcpServerOpen returned $ret"; + } else { + $hash->{STATE} = "opened"; + readingsSingleUpdate($hash, "state", "opened", 1); + } + } else { + Log3 $name, 5, "$name: open called from $caller" if ($caller ne "Ready"); + if ($hash->{BUSY_OPENDEV}) { # still waiting for callback to last open + if ($hash->{LASTOPEN} && $now > $hash->{LASTOPEN} + (AttrVal($name, "openTimeout", 3) * 2) + && $now > $hash->{LASTOPEN} + 15) { + Log3 $name, 3, "$name: open - still waiting for open callback, timeout is over twice - this should never happen"; + Log3 $name, 3, "$name: open - stop waiting for callback and reset the BUSY flag."; + $hash->{BUSY_OPENDEV} = 0; + } else { + return; + } + } + if (!$ready) { # not called from _Ready + if ($closeFirst && DevIo_IsOpen($hash)) { # close first and already open + Log3 $name, 5, "$name: Open called for DevIo connection - closing first"; + Modbus_Close($hash, 1); # close, set Expect, clear Buffer, don't set state to disconnected + delete $hash->{NEXT_OPEN}; + delete $hash->{DevIoJustClosed}; # allow direct opening without further delay + } else { + if ($hash->{LASTOPEN} && $now < $hash->{LASTOPEN} + (AttrVal($name, "openTimeout", 3))) { + # ignore too many open requests within openTimeout without close inbetween (let ready do its job) + Log3 $name, 5, "$name: successive open ignored"; + return; + } + } + } + Log3 $name, 4, "$name: open trying to open connection to $hash->{DeviceName}" if (!$ready); + $hash->{IODev} = $hash if ($hash->{TCPConn}); # point back to self + $hash->{BUSY_OPENDEV} = 1; + $hash->{LASTOPEN} = $now; + $hash->{nextOpenDelay} = AttrVal($name, "nextOpenDelay", 60); + $hash->{devioLoglevel} = (AttrVal($name, "silentReconnect", 0) ? 4 : 3); + $hash->{TIMEOUT} = AttrVal($name, "openTimeout", 3); + if ($force) { + DevIo_OpenDev($hash, $ready, 0); # standard open + } else { + DevIo_OpenDev($hash, $ready, 0, \&Modbus_OpenCB); # async open + } + } + $hash->{EXPECT} = (!$hash->{MODE} || $hash->{MODE} eq 'master' ? 'idle' : 'request'); + Modbus_StopQueueTimer($hash); + $hash->{READ}{BUFFER} = ""; # clear Buffer for reception + delete $hash->{TIMEOUT}; + return; +} - my $ioHash = ModbusLD_GetIOHash($hash); - my $ioName = $ioHash->{NAME}; - Log3 $name, 3, "$name: _ReadAnswer called but IO Device is disabled" if (IsDisabled ($ioName)); - return ("IO Device is disabled", undef) if (IsDisabled ($ioName)); - return ("No FD", undef) if (!$ioHash); - return ("No FD", undef) if ($^O !~ /Win/ && !defined($ioHash->{FD})); + +##################################### +sub Modbus_OpenCB($$) +{ + my ($hash, $msg) = @_; + my $name = $hash->{NAME}; + if ($msg) { + Log3 $name, 5, "$name: Open callback: $msg" if ($msg); + } + delete $hash->{BUSY_OPENDEV}; + if (DevIo_IsOpen($hash)) { + delete $hash->{TIMEOUTS} ; + ModbusLD_StartUpdateTimer($hash); # if INTERVAL is set in this device + } + return; +} + + +################################################## +# close connection +# $hash is physical or both (connection over TCP) +sub Modbus_Close($;$$) +{ + my ($hash, $noState, $noDelete) = @_; + my $name = $hash->{NAME}; + + if (!$hash->{TCPConn} && $hash->{TYPE} ne 'Modbus') { + Log3 $name, 3, "$name: close called from " . Modbus_Caller() . + " for logical device - this should not happen"; + return; + } + + Log3 $name, 5, "$name: Close called from " . Modbus_Caller() . + ($noState || $noDelete ? " with " : "") . ($noState ? "noState" : "") . + ($noState && $noDelete ? " and " : "") . ($noDelete ? "noDelete" : ""); + + delete $hash->{LASTOPEN}; # reset so next open will actually call OpenDev + if ($hash->{TCPChild}) { + if (defined($hash->{CD})) { # connection hash + Log3 $name, 4, "$name: Close TCP server connection and delete hash"; + TcpServer_Close($hash); + RemoveInternalTimer ("stimeout:$name"); + CommandDelete(undef, $name) if (!$noDelete); + if ($hash->{CHILDOF} && $hash->{CHILDOF}{LASTCONN} && $hash->{CHILDOF}{LASTCONN} eq $hash->{NAME}) { + Log3 $name, 5, "$name: Close is removing lastconn from parent device $hash->{CHILDOF}{NAME}"; + delete $hash->{CHILDOF}{LASTCONN} + } + } + } elsif ($hash->{TCPServer}) { + if ($hash->{FD}){ + Log3 $name, 4, "$name: Close TCP server socket, now look for active connections"; + TcpServer_Close($hash); + foreach my $conn (keys %{$hash->{CONNECTHASH}}) { + my $chash = $hash->{CONNECTHASH}{$conn}; + TcpServer_Close($chash); + Log3 $chash->{NAME}, 4, "$chash->{NAME}: Close TCP server connection of parent $name and delete hash"; + RemoveInternalTimer ("stimeout:$chash->{NAME}"); + CommandDelete(undef, $chash->{NAME}) if (!$noDelete); + } + delete $hash->{CONNECTHASH}; + Log3 $name, 4, "$name: Close deleted CONNECTHASH"; + } + } elsif (DevIo_IsOpen($hash)) { + Log3 $name, 4, "$name: Close connection with DevIo_CloseDev"; + DevIo_CloseDev($hash); + } + + if (!$noState) { + $hash->{STATE} = "disconnected"; + readingsSingleUpdate($hash, "state", "disconnected", 1); + } + + $hash->{EXPECT} = 'idle'; + $hash->{READ}{BUFFER} = ""; # clear Buffer for reception + Modbus_StopQueueTimer($hash); + RemoveInternalTimer ("timeout:$name"); + ModbusLD_StopUpdateTimer($hash); + delete $hash->{nextTimeout}; + delete $hash->{QUEUE}; +} + + +# ready fn for physical device +# and logical device (in case of tcp when logical device opens connection) +########################################################################### +sub Modbus_Ready($) +{ + my ($hash) = @_; + my $name = $hash->{NAME}; + + if($hash->{STATE} eq "disconnected") { + if (IsDisabled($name)) { + Log3 $name, 3, "$name: ready called but $name is disabled - don't try to reconnect"; + Modbus_Close($hash, 1); # close, set Expect, clear Buffer, don't set state to disconnected + return; + } + Modbus_Open($hash, 1); # reopen, dont call DevIoClose before reopening + return; # a return value only triggers direct read for windows - main loop select + } + # This is relevant for windows/USB only + my $po = $hash->{USBDev}; + if ($po) { + my ($BlockingFlags, $InBytes, $OutBytes, $ErrorFlags) = $po->status; + return ($InBytes>0); # tell fhem.pl to read when we return if data available + } + return; +} + + + + +##################################### +# Called from the global loop, when the select for hash->{FD} reports data +# hash is hash of the physical device ( = logical device for TCP) +sub Modbus_HandleServerConnection($) +{ + my $hash = shift; + my $name = $hash->{NAME}; + my $chash = TcpServer_Accept($hash, $hash->{TYPE}); # accept with this module + return if(!$chash); + $chash->{CD}->flush(); + Log3 $name, 4, "$name: HandleServerConnection accepted new TCP connection as device $chash->{NAME}"; + $chash->{MODBUSID} = $hash->{MODBUSID}; + $chash->{PROTOCOL} = $hash->{PROTOCOL}; + $chash->{MODE} = $hash->{MODE}; + $chash->{RELAY} = $hash->{RELAY}; + $chash->{CHILDOF} = $hash; # point to parent device to get object definitions from there + $chash->{IODev} = $chash; + $chash->{TCPConn} = 1; + $chash->{TCPChild} = 1; + $chash->{EXPECT} = 'request'; + DoTrigger("global", "DEFINED $chash->{NAME}", 1) if($init_done); + $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->{CONNECTHASH}{$chash->{NAME}} = $chash; + CommandAttr(undef, "$chash->{NAME} room Connections"); # try to set room (doesn't work reliably yet) + + my $to = gettimeofday() + Modbus_DevInfo($hash, "timing", "serverTimeout", 120); + InternalTimer($to, "Modbus_ServerTimeout", "stimeout:$chash->{NAME}", 0); + + return; +} + + +############################################## +# check time gap between now and last read +# to clear old buffer or set expect to request +sub Modbus_HandleGaps($) +{ + my $hash = shift; + my $name = $hash->{NAME}; + my $now = gettimeofday(); + + # check timing / frameGap and remove old buffer if necessary + my $to = AttrVal($name, "frameGap", 1.5); + if ($hash->{REMEMBER}{lrecv}) { + my $gap = ($now - $hash->{REMEMBER}{lrecv}); + if ($gap > $to && $hash->{READ}{BUFFER}) { + Log3 $name, 5, "$name: read drops existing buffer content " . + unpack ('H*', $hash->{READ}{BUFFER}) . " after " . sprintf ('%.2f', $gap) . " secs."; + $hash->{READ}{BUFFER} = ''; + } + if ($gap > $to * 2) { + if ($hash->{MODE} ne 'master') { + $hash->{EXPECT} = 'request'; + Log3 $name, 5, "$name: read gap is twice timeout -> expecting a new request now"; + } + } + } else { + if ($hash->{READ}{BUFFER}) { + Log3 $name, 5, "$name: read initially clears existing buffer content " . + unpack ('H*', $hash->{READ}{BUFFER}); + $hash->{READ}{BUFFER} = ''; + } + } +} + + +##################################### +# Called from the global loop, when the select for hash->{FD} reports data +# hash is hash of the physical device ( = logical device for TCP) +sub Modbus_Read($) +{ + my $hash = shift; + my $name = $hash->{NAME}; + my $now = gettimeofday(); + my $buf; + + if (!$hash->{MODE} || !$hash->{PROTOCOL}) { # MODE and PROTOCOL keys are taken from logical device in NOTIFY + $hash->{READ}{BUFFER} = ''; # nothing defined / initializd yet + return; # EXPECT doesn't matter, Logging frame not needed + } + + if($hash->{TCPServer} || $hash->{TCPChild}) { + # TCP Server mode + if($hash->{SERVERSOCKET}) { + # this is a TCP server / modbus slave device , accept and create a child device hash for the connection + Modbus_HandleServerConnection($hash); + return; + } else { # TCP client device connection device hash + Modbus_Profiler($hash, "Read"); + my $ret = sysread($hash->{CD}, $buf, 256) if ($hash->{CD}); + if(!defined($ret) || $ret <= 0) { # connection closed + Log3 $name, 3, "$name: read from TCP server connection got null -> closing"; + CommandDelete(undef, $name); + return; + } + RemoveInternalTimer ("stimeout:$name"); + my $to = $now + Modbus_DevInfo($hash, "timing", "serverTimeout", 120); + InternalTimer($to, "Modbus_ServerTimeout", "stimeout:$name", 0); + } + } else { + Modbus_Profiler($hash, "Read"); + $buf = DevIo_SimpleRead($hash); + return if(!defined($buf)); + } + + Modbus_HandleGaps ($hash); # check timing / frameGap and remove old buffer if necessary + $hash->{READ}{BUFFER} .= $buf; + $hash->{REMEMBER}{lrecv} = $now; # physical side + Log3 $name, 5, "$name: read buffer: " . unpack ('H*',$hash->{READ}{BUFFER}); + delete $hash->{FRAME}; # remove old stuff + + for (;;) { + # parse frame start, create $hash->{FRAME} with {MODBUSID}, {FCODE}, {DATA} + # and for TCP also $hash->{FRAME}{PDULEXP} and $hash->{FRAME}{TID} + if (!Modbus_ParseFrameStart($hash)) { + # not enough data / no frame match + Log3 $name, 5, "$name: read did not see a valid frame start yet, wait for more data"; + return; + } + my $frame = $hash->{FRAME}; # is set after HandleFrameStart + + if ($hash->{EXPECT} eq 'response') { # --- RESPONSE --- + if (Modbus_HandleResponse($hash)) { # check for valid PDU, CRC, parse, set DEVHASH, log, drop data, ret 1 if done + delete $hash->{REQUEST}; + delete $hash->{RESPONSE}; + Modbus_StartQueueTimer($hash, 0); # call processRequestQueue at next possibility if appropriate + } else { + return; # wait for more data + } + + } elsif ($hash->{EXPECT} eq 'request') { # --- REQUEST --- + if (Modbus_HandleRequest($hash)) { # check for valid PDU, parse, set DEVHASH, ret 1 if finished + # ERROR is only set by Checkum Check or unsupported fCode here. + } else { + return; # wait for more data + } + } elsif ($hash->{EXPECT} eq 'waitrelay') { # still waiting for response from relay device + Log3 $name, 3, "$name: read got new data while waiting for relay response, expect $hash->{EXPECT}, drop buffer " . + unpack ('H*', $hash->{READ}{BUFFER}); + $hash->{READ}{BUFFER} = ''; + return; + + } elsif ($hash->{EXPECT} eq 'idle') { # master is doing nothing but maybe there is an illegal other master? + Log3 $name, 3, "$name: read got new data while idle, drop buffer " . + unpack ('H*', $hash->{READ}{BUFFER}); + $hash->{READ}{BUFFER} = ''; + return; + + } else { + Log3 $name, 3, "$name: internal error, illegal EXPECT value $hash->{EXPECT}, drop buffer " . + unpack ('H*', $hash->{READ}{BUFFER}); + $hash->{READ}{BUFFER} = ''; + return; + + } + return if (!$hash->{READ}{BUFFER}); # return if no more data, else parse on + } +} + + + +################################################################################ +# Called from get / set to get a direct answer - only for Fhem as master. +# calls ReadAnswerTimeout or ReadAnswerError +# Returns an error message or undef if success. +# queue time is started after calling ReadAnswer as well as in ReadAnswerTimeout and ReadAnswerError +sub Modbus_ReadAnswer($) +{ + my ($hash) = @_; # called with physicak io device hash + my $name = $hash->{NAME}; + my $now = gettimeofday(); + + Log3 $name, 5, "$name: ReadAnswer called from " . Modbus_Caller(); + + return "No IO Device hash" if (!$hash); + if (IsDisabled ($name)) { + return Modbus_ReadAnswerError($hash, "ReadAnswer called but Device $name is disabled"); + } + return Modbus_ReadAnswerError($hash, "ReadAnswer called but Device $name is not connected") + if ($^O !~ /Win/ && !defined($hash->{FD})); + return Modbus_ReadAnswerError($hash, "ReadAnswer called but Device $name mode or protocol not set") + if (!$hash->{MODE} || !$hash->{PROTOCOL}); + # MODE and PROTOCOL are set in Notify for logcal device. Probably this case can never happen + # for these early returns nothing more needs to be done because further sending / reading fails anyway my $buf; my $rin = ''; - # get timeout. In case ReadAnswer is called after a delay + my $logHash = $hash->{REQUEST}{DEVHASH}; # logical device that sent the last request + # note that this might be a diffrent logical device than the one we got called from! + # get timeout. In case ReadAnswer is called after a delay or to take over an async read, # only wait for remaining time - my $to = ModbusLD_DevInfo($hash, "timing", "timeout", 2); - my $rest = ($ioHash->{nextTimeout} ? $ioHash->{nextTimeout} - $now : 0); - + my $to = Modbus_DevInfo($logHash, "timing", "timeout", 2); + my $rest = ($hash->{nextTimeout} ? $hash->{nextTimeout} - $now : 0); + # nextTimeout is set when a request is sent. This can be the last getUpdate or the get/set + if ($rest <= 0) { - Log3 $name, 5, "$name: ReadAnswer called but timeout already over" . - ($reading ? " requested reading was $reading" : ""); - return ("Timeout reading answer", undef); + return Modbus_ReadAnswerTimeout($hash, "Timeout already over when ReadAnswer is called"); } if ($rest < $to) { - Log3 $name, 5, "$name: ReadAnswer called and remaining timeout is $rest" . - ($reading ? " requested reading is $reading" : ""); + Log3 $name, 5, "$name: ReadAnswer called and remaining timeout is $rest"; $to = $rest; } else { - Log3 $name, 5, "$name: ReadAnswer called" . ($reading ? " for $reading" : ""); + Log3 $name, 5, "$name: ReadAnswer called"; } - delete $hash->{gotReadings}; - $reading = "" if (!$reading); + RemoveInternalTimer ("timeout:$name"); # remove timer, timeout is handled in here now + Modbus_Profiler($hash, "Read"); + for (;;) { - Modbus_Profiler($ioHash, "Read"); - for(;;) { - - if($^O =~ m/Win/ && $ioHash->{USBDev}) { - $ioHash->{USBDev}->read_const_time($to*1000); # set timeout (ms) - $buf = $ioHash->{USBDev}->read(999); + if($^O =~ m/Win/ && $hash->{USBDev}) { + $hash->{USBDev}->read_const_time($to*1000); # set timeout (ms) + $buf = $hash->{USBDev}->read(999); if(length($buf) == 0) { - my $logLvl = AttrVal($ioHash->{NAME}, "timeoutLogLevel", 3); - Log3 $name, $logLvl, "$name: Timeout in ReadAnswer" . ($reading ? " for $reading" : ""); - Modbus_CountTimeouts ($ioHash); - return ("Timeout reading answer", undef) + return Modbus_ReadAnswerTimeout($hash, "Timeout waiting for a modbus response in ReadAnswer"); } } else { - if(!$ioHash->{FD}) { - Log3 $name, 3, "$name: Device lost in ReadAnswer". ($reading ? " for $reading" : ""); - return ("Device lost when reading answer", undef); + if(!$hash->{FD}) { + return Modbus_ReadAnswerError($hash, "ReadAnswer called but Device $name lost connection"); } - - vec($rin, $ioHash->{FD}, 1) = 1; # setze entsprechendes Bit in rin + vec($rin, $hash->{FD}, 1) = 1; # setze entsprechendes Bit in rin my $nfound = select($rin, undef, undef, $to); if($nfound < 0) { next if ($! == EAGAIN() || $! == EINTR() || $! == 0); my $err = $!; - DevIo_Disconnected($ioHash); + DevIo_Disconnected($hash); # close, set state but put back on readyfnlist for reopening Log3 $name, 3, "$name: ReadAnswer error: $err"; - return("Modbus_ReadAnswer error: $err", undef); + return "Modbus_ReadAnswer error: $err"; } if($nfound == 0) { - my $logLvl = AttrVal($ioHash->{NAME}, "timeoutLogLevel", 3); - Log3 $name, $logLvl, "$name: Timeout2 in ReadAnswer" . ($reading ? " for $reading" : ""); - Modbus_CountTimeouts ($ioHash); - return ("Timeout reading answer", undef); + return Modbus_ReadAnswerTimeout($hash, "Timeout waiting for a modbus response in ReadAnswer"); } - $buf = DevIo_SimpleRead($ioHash); + $buf = DevIo_SimpleRead($hash); if(!defined($buf)) { - Log3 $name, 3, "$name: ReadAnswer got no data" . ($reading ? " for $reading" : ""); - return ("No data", undef); + return Modbus_ReadAnswerError($hash, "ReadAnswer got no data"); } } - if($buf) { - $ioHash->{helper}{buffer} .= $buf; $now = gettimeofday(); - $hash->{helper}{lrecv} = $now; - $ioHash->{helper}{lrecv} = $now; - Log3 $name, 5, "$name: ReadAnswer got: " . unpack ("H*", $ioHash->{helper}{buffer}); + $hash->{READ}{BUFFER} .= $buf; + $hash->{REMEMBER}{lrecv} = $now; + $logHash->{REMEMBER}{lrecv} = $now; + Log3 $name, 5, "$name: ReadAnswer got: " . unpack ("H*", $hash->{READ}{BUFFER}); } - - my $code = Modbus_ParseFrames($ioHash); - if ($code) { - if ($code ne "1") { - Log3 $name, 5, "$name: ReadAnswer: ParseFrames returned error: $code"; - return ($code, undef); + + delete $hash->{FRAME}; # remove old stuff + # get $hash->{FRAME}{MODBUSID}, $hash->{FRAME}{FCODE}, $hash->{FRAME}{DATA} + # and for TCP also $hash->{FRAME}{PDULEXP} and $hash->{FRAME}{TID} + if (!Modbus_ParseFrameStart($hash)) { + # not enough data / no frame match + Log3 $name, 5, "$name: ReadAnswer got no valid frame after HandleFrameStart, wait for more data"; + next; + } + my $frame = $hash->{FRAME}; # is set after HandleFrameStart + # check for valid PDU with checksum, parse, remove, log + if (Modbus_HandleResponse($hash)) { # end of parsing. error or valid frame, calls ResponseDone at end + my $ret; + if ($hash->{RESPONSE}{ERRCODE}) { + $ret = "Error code $hash->{RESPONSE}{ERRCODE} / $Modbus_errCodes{$hash->{RESPONSE}{ERRCODE}}"; + Log3 $name, 5, "$name: ReadAnswer got $ret"; } - - Log3 $name, 5, "$name: ReadAnswer done" . ($reading ? ", reading is $reading" : "") . - (defined($hash->{gotReadings}{$reading}) ? ", value: $hash->{gotReadings}{$reading}" : ""); - if ($reading && defined($hash->{gotReadings}{$reading})) { - return (undef, $hash->{gotReadings}{$reading}); # no error - } - return (undef, undef); # no error but also no value + delete $hash->{REQUEST}; + delete $hash->{RESPONSE}; + return $ret; } } - return ("no Data", undef); } -sub Modbus_compObjKeys ($$) { - my ($a, $b) = @_; - my $aType = substr($a, 0, 1); - my $aStart = substr($a, 1); - my $bType = substr($b, 0, 1); - my $bStart = substr($b, 1); - my $result = ($aType cmp $bType); - if ($result) { - return $result; +sub Modbus_SkipGarbageCheck($$) +{ + my ($hash, $startByte) = @_; + my $name = $hash->{NAME}; + my ($start, $skip); + + $start = index($hash->{READ}{BUFFER}, $startByte); + if ($start > 0) { + $skip = substr($hash->{READ}{BUFFER}, 0, $start); + $hash->{READ}{BUFFER} = substr($hash->{READ}{BUFFER}, $start); + Log3 $name, 4, "$name: SkipGarbageCheck skipped $start bytes (" . + unpack ('H*', $skip) . " from " . unpack ('H*', $hash->{READ}{BUFFER}) . ")"; } - $result = $aStart <=> $bStart; - return $result; + return $hash->{READ}{BUFFER}; } + +##################################################### +# parse the beginning of a request or response frame +sub Modbus_ParseFrameStart($) +{ + my ($hash) = @_; + my $name = $hash->{NAME}; + my $proto = $hash->{PROTOCOL}; + my $expId = $hash->{REQUEST}{MODBUSID} if ($hash->{REQUEST} && $hash->{REQUEST}{MODBUSID}); + my $frameString = $hash->{READ}{BUFFER}; + my ($id, $fCode, $data, $tid, $dlen, $pdu, $null); + + #Log3 $name, 5, "$name: ParseFrameStart called from " . Modbus_Caller(); + use bytes; + if ($proto eq "RTU") { + # Skip for RTU only works when expectId is passed (parsing Modbus responses from a known Id) + $frameString = Modbus_SkipGarbageCheck($hash, pack('C', $expId)) if ($expId); + if ($frameString =~ /(..)(.+)(..)/s) { # (id fCode) (data) (crc) /s means treat as single line ... + ($id, $fCode) = unpack ('CC', $1); + $data = $2; + } else { + return undef; # data still incomplete - continue reading + } + + } elsif ($proto eq "ASCII") { + $frameString = Modbus_SkipGarbageCheck($hash, ':'); + if ($frameString =~ /:(..)(..)(.+)(..)\r\n/) {# : (id) (fCode) (data) (lrc) \r\n + no warnings; # no warning if data is not hex + $id = hex($1); + $fCode = hex($2); + $data = pack('H*', $3); + } else { + return undef; # data still incomplete - continue reading + } + + } elsif ($proto eq "TCP") { + if (length($frameString) < 8) { + return undef; + } + ($tid, $null, $dlen, $id, $pdu) = unpack ('nnnCa*', $frameString); + ($fCode, $data) = unpack ('Ca*', $pdu); + $hash->{FRAME}{TID} = $tid; + $hash->{FRAME}{PDULEXP} = $dlen-1; # data length without id + #Log3 $name, 5, "$name: ParseFrameStart for TCP extracted tid $tid, null, dlen $dlen, id $id and pdu " . unpack ('H*', $pdu); + } + $hash->{FRAME}{MODBUSID} = $id; + $hash->{FRAME}{FCODE} = $fCode; + $hash->{FRAME}{DATA} = $data; + Log3 $name, 5, "$name: ParseFrameStart ($proto) extracted id $id, fCode $fCode" . + ($hash->{FRAME}{TID} ? ", tid " . $hash->{FRAME}{TID} : "") . + ($dlen ? ", dlen " . $dlen : "") . + " and data " . unpack ('H*', $data); + return 1; +} + + +############################################################################# +# called after ParseFrameStart by read / readAnswer if we are master +# check that response fits our request_method, call parseResponse +# validate checksums, call parseObj to set readings +# return undef if need more data or 1 if final success or error. +# responseDone is called at the end +# +# note that we could be the master part of a relay and the request +# might have come in through a TCP slave part of the relay +# so data in the response might need to be interpreted in the context +# of a TCP slave parent device ... +############################################################################# +sub Modbus_HandleResponse($) +{ + my ($hash) = @_; + my $name = $hash->{NAME}; + my $frame = $hash->{FRAME}; + my $logHash; + my $request = $hash->{REQUEST}; + + Log3 $name, 5, "$name: HandleResponse called from " . Modbus_Caller(); + + if ($request) { + $logHash = $request->{DEVHASH}; + if ($request->{FRAME} && $hash->{READ}{BUFFER} eq $request->{FRAME} && $frame->{FCODE} < 5) { + Log3 $name, 3, "$name: HandleResponse read the same data sent before - looks like an echo!"; + # just log, looks strange but might be ok. + } + + if ($frame->{MODBUSID} != $request->{MODBUSID} && $request->{MODBUSID} != 0) { + Modbus_AddFrameError($frame, "Modbus ID $frame->{MODBUSID} of response does not match request ID $request->{MODBUSID}"); + } + if ($hash->{PROTOCOL} eq "TCP" && $request->{TID} != $frame->{TID}) { + Modbus_AddFrameError($frame, "TID $frame->{TID} in Modbus TCP response does not match request TID $request->{TID}"); + } + if ($request->{FCODE} != $frame->{FCODE} && $frame->{FCODE} < 128) { + Modbus_AddFrameError($frame, "Function code $frame->{FCODE} in Modbus response does not match request function code $request->{FCODE}"); + } + } else { + Log3 $name, 5, "$name: HandleResponse got data but we don't have a request"; + $logHash = Modbus_GetLogHash ($hash, $frame->{MODBUSID}); + } + + $logHash->{REMEMBER}{lrecv} = gettimeofday() if ($logHash); + + my %responseData; # create new response structure + my $response = \%responseData; + $response->{ADR} = $request->{ADR}; # prefill so we don't need $request in ParseResponse and it gets shorter + $response->{LEN} = $request->{LEN}; + $response->{DEVHASH} = $request->{DEVHASH}; # needed for relay responses + $response->{OPERATION} = $request->{OPERATION}; # for later call to parseObj + + my %brokenFC; + if ($logHash) { + $brokenFC{3} = Modbus_DevInfo($logHash, "c", "brokenFC3", 0); + $brokenFC{5} = Modbus_DevInfo($logHash, "c", "brokenFC5", 0); + } else { + $brokenFC{3} = 0; + } + + # parse response and fill response hash + # also $frame->{PDULEXP} will be set now if not already earlier. + if (!Modbus_ParseResponse($hash, $response, %brokenFC)) { + return; # frame not complete - continue reading + } + $hash->{RESPONSE} = $response; # save for later parsing of response + my $frameLen = $frame->{PDULEXP} + $Modbus_PDUOverhead{$hash->{PROTOCOL}}; + my $readLen = length($hash->{READ}{BUFFER}); + + Modbus_CheckChecksum($hash); # calls AddFrameError if needed so $frame->{ERROR} might be set afterwards if checksum wrong + + if ($frame->{ERROR}) { # can be wrong ID, TID or fCode (set above) or unsupported fCode or bad checksum + if ($readLen < $frameLen ) { + Log3 $name, 5, "$name: HandleResponse did not get a valid frame yet, wait for more data"; + return; # frame not complete and error - continue reading + } + } else { + # no error so far + if ($readLen < $frameLen ) { + # frame is too small but no error - even checksum is fine! + if (!$logHash || !Modbus_DevInfo($logHash, $response->{TYPE}, "allowShortResponses", 0)) { + Log3 $name, 5, "$name: HandleResponse got a short Frame with valid checksum - wait for more data"; + return; # frame seems valid but is too short and short frames are not allowed -> continue reading + } + } + + # got a valid frame, long enough + Modbus_Profiler($hash, "Fhem"); + if ($response->{ERRCODE}) { # valid error message response + my $hexFCode = unpack ("H*", pack("C", $response->{FCODE})); + my $errCode = $Modbus_errCodes{$response->{ERRCODE}}; + if ($logHash) { # be quiet if no logical device hash (not our responsibility) + Log3 $name, 4, "$name: HandleResponse got response with error code $hexFCode / $response->{ERRCODE}" . + ($errCode ? ", $errCode" : ""); + } + } else { # no error response, now check if we can parse data + if ($frame->{FCODE} < 15) { # is there data to parse? (nothing to parse after response to 15 / 16) + if ($logHash) { + # loghash is the logical device stored as DEVHASH in Request + # that's the device that sent the request if we are the master + # or the salve part of a relay that received the original request + # or (if no request) the device registered with id (probably this doesn't lead anywhere then) + + my $parseLogHash1 = ($logHash->{CHILDOF} ? $logHash->{CHILDOF} : $logHash); + if ($parseLogHash1) { # try to parse in logical device that sent request + Log3 $name, 5, "$name: HandleResponse now passing to logical device $parseLogHash1->{NAME} for parsing data"; + ModbusLD_ParseObj($parseLogHash1, $response); + Log3 $name, 5, "$name: HandleResponse got " . scalar keys (%{$parseLogHash1->{gotReadings}}) . " readings from ParseObj for $parseLogHash1->{NAME}"; + } + } + if ($logHash->{MODE} eq 'relay' && $logHash->{RELAY}) { + # as a relay also try to parse the response in the logical relay forward device + my $parseLogHash2 = $defs{$logHash->{RELAY}}; + if ($parseLogHash2) { + Log3 $name, 5, "$name: HandleResponse now also passing to logical device $parseLogHash2->{NAME} for parsing data"; + ModbusLD_ParseObj($parseLogHash2, $response); + Log3 $name, 5, "$name: HandleResponse got " . scalar keys (%{$parseLogHash2->{gotReadings}}) . " readings from ParseObj for $parseLogHash2->{NAME}"; + } + } + } + } + if ($response->{DEVHASH} && $response->{DEVHASH}{MODE} eq 'relay') { + Modbus_RelayResponse($hash); # add to {ERROR} if relay device is unavailable + } + } + Modbus_ResponseDone($hash, 4); # log, profiler, drop data, timer + return 1; # error or not, parsing is done. +} + + +# +# Parse Response, called from handleResponse with +# require {FRAME} to be filled before by HandleFrameStart +# fill {RESPONSE} and some more fields of {FRAME} +####################################################################### +sub Modbus_ParseResponse($$%) +{ + my ($hash, $response, %brokenFC) = @_; + my $name = $hash->{NAME}; + my $frame = $hash->{FRAME}; + Log3 $name, 5, "$name: ParseResponse called from " . Modbus_Caller(); + + return undef if (!$frame->{FCODE}); # function code has been extracted + my $fCode = $frame->{FCODE}; # filled in handleFrameStart + my $data = $frame->{DATA}; + + use bytes; + $response->{FCODE} = $fCode; + $response->{MODBUSID} = $frame->{MODBUSID}; + + # if we don't have enough data then checksum check will fail later which is fine. + # however unpack might produce undefined results if there is not enough data so return early. + my $dataLength = length($data); + if ($fCode == 1 || $fCode == 2) { + # read coils / discrete inputs, pdu: fCode, num of bytes, coils + # adr and len are copied from request + return if ($dataLength) < 1; + my ($len, $values) = unpack ('Ca*', $data); # length of values data and values from frame + $response->{VALUES} = $values; + $response->{TYPE} = ($fCode == 1 ? 'c' : 'd'); # coils or discrete inputs + $frame->{PDULEXP} = $len + 2; # 1 Byte fCode + 1 Byte len + len of expected values + + } elsif ($fCode == 3 || $fCode == 4) { + # read holding/input registers, pdu: fCode, num of bytes, registers + return if ($dataLength) < 1; + my ($len, $values) = unpack ('Ca*', $data); + $response->{TYPE} = ($fCode == 3 ? 'h' : 'i'); # holding registers / input registers + $frame->{PDULEXP} = $len + 2; # 1 Byte fCode + 1 Byte len + len of expected values + if ($brokenFC{3} && $fCode == 3) { + # devices that respond with wrong pdu pdu: fCode, adr, registers + Log3 $name, 5, "$name: ParseResponse uses fix for broken fcode 3"; + my $adr; + ($adr, $values) = unpack ('na*', $data); + $response->{ADR} = $adr; # adr of registers + $frame->{PDULEXP} = $response->{LEN} * 2 + 3; # 1 Byte fCode + 2 Byte adr + 2 bytes per register + } + $response->{VALUES} = $values; + + } elsif ($fCode == 5) { + # write single coil, pdu: fCode, adr, coil (FF00) + return if ($dataLength) < 3; + my ($adr, $values) = unpack ('nH4', $data); # 2 bytes adr, 2 bytes values + if ($brokenFC{5} && $fCode == 5) { + Log3 $name, 5, "$name: ParseResponse uses fix for broken fcode 5"; + $values = ($values eq "0000" ? 0 : 1); + } else { + $values = ($values eq "ff00" ? 1 : 0); + } + $response->{ADR} = $adr; # adr of coil + $response->{LEN} = 1; # always one coil + $response->{VALUES} = $values; + $response->{TYPE} = 'c'; # coils + $frame->{PDULEXP} = 5; # 1 Byte fCode + 2 Bytes adr + 2 Bytes coil + + } elsif ($fCode == 6) { + # write single (holding) register, pdu: fCode, adr, register + return if ($dataLength) < 2; + my ($adr, $values) = unpack ('na*', $data); + $response->{ADR} = $adr; # adr of register + $response->{VALUES} = $values; + $response->{TYPE} = 'h'; # holding registers + $frame->{PDULEXP} = 5; # 1 Byte fCode + 2 Bytes adr + 2 Bytes register + + } elsif ($fCode == 15 || $fCode == 16) { + # write mult coils/hold. regis, pdu: fCode, adr, len + return if ($dataLength) < 2; + $response->{TYPE} = ($fCode == 15 ? 'c' : 'c'); # coils / holding registers + $frame->{PDULEXP} = 5; # 1 byte fCode + 2 byte adr + 2 bytes len + # response to fc 15 / 16 does not contain data -> nothing to be done, parseObj will not be called + + } elsif ($fCode >= 128) { + # error fCode pdu: fCode, data + return if ($dataLength) < 1; + $response->{ERRCODE} = unpack ("H2", $data); + $frame->{PDULEXP} = 2; # 1 byte error fCode + 1 code + } else { + # other function code + Modbus_AddFrameError($frame, "Function code $fCode not implemented"); + $frame->{PDULEXP} = 2; + # todo: now we don't know the length! maybe better drop everything we have ... + } + $response->{PDU} = pack ('C', $fCode) . substr($data, 0, $frame->{PDULEXP}); + return 1; # go on with other checks / handling / dropping +} + +# +# Daten aufbereiten: +# Modul ist Master, gelesene Daten von einem Gerät zu Readings expr, format, map, ... +# set von Fhem, Daten an Gerät senden, kein Format, aber setexpr +# +# Modul ist Slave, angefragte Daten an einen anderen Master liefern, setexpr, inverse map +# geschriebene Daten von einem anderen Master in Readings, map, expr, format, ... +# +# + +################################################# +# Parse holding / input register / coil Data +# called from ParseResponse which is only called from HandleResponse +# or from HandleRequest (for write requests as slave) +# with logical device hash, data string +# and the object type/adr to start with +sub ModbusLD_ParseObj($$) { + my ($logHash, $dataPtr) = @_; + # $dataPtr can be response (mode master) or request (mode slave and write request) + my $name = $logHash->{NAME}; + my $type = $dataPtr->{TYPE}; + my $startAdr = $dataPtr->{ADR}; + my $valuesLen = $dataPtr->{LEN}; + my $op = $dataPtr->{OPERATION}; + my $lastAdr = ($valuesLen ? $startAdr + $valuesLen -1 : 0); + my ($unpack, $format, $expr, $ignExpr, $map, $rest, $objLen, $encode, $decode); + $op = "" if (!$op); + Log3 $name, 5, "$name: ParseObj called with data " . unpack ("H*", $dataPtr->{VALUES}) . ", type $type, adr $startAdr" . ($valuesLen ? ", valuesLen $valuesLen" : "") . ($op ? ", op $op" : ""); + delete $logHash->{gotReadings}; # will be filled later and queried by caller + + if ($type =~ "[cd]") { + # valuesLen is only used for coils / discrete inputs + $valuesLen = 1 if (!$valuesLen); + $rest = unpack ("b$valuesLen", $dataPtr->{VALUES}); # convert binary data to bit string + Log3 $name, 5, "$name: ParseObj shortened coil / input bit string: " . $rest . ", start adr $startAdr, valuesLen $valuesLen"; + } else { + $rest = $dataPtr->{VALUES}; + } + use bytes; + readingsBeginUpdate($logHash); + while (length($rest) > 0) { + # einzelne Felder verarbeiten + my $key = $type . $startAdr; + my $reading = Modbus_ObjInfo($logHash, $key, "reading"); # "" if nothing specified + + if ($op =~ /scanid([0-9]+)/) { # scanning for Modbus ID + $reading = "scanId-" . $1 . "-Response-$key"; + $logHash->{MODBUSID} = $1; + Log3 $name, 3, "$name: ParseObj scanIds got response from Id $1 - set internal MODBUSID to $1"; + } elsif ($op eq 'scanobj') { # scan Modbus objects + Log3 $name, 5, "$name: ParseObj scanobj reading=$reading"; + if (!$reading) { + my $fKey = $type . sprintf ("%05d", $startAdr); + $reading = "scan-$fKey"; + Log3 $name, 5, "$name: ParseObj scanobj sets reading=$reading"; + CommandAttr(undef, "$name obj-${fKey}-reading $reading"); + } + if ($type =~ "[hi]") { + my $l = length($rest) / 2; + $l = 1 if ($l < 1); + CommandAttr(undef, "$name dev-h-defLen $l") + if (AttrVal($name, "dev-h-defLen", "") ne "$l"); + CommandAttr(undef, "$name dev-h-defUnpack a" . $l*2) + if (AttrVal($name, "dev-h-defUnpack", "") ne ('a'.$l*2)); + CommandAttr(undef, "$name dev-h-defExpr ModbusLD_ScanFormat(\$hash, \$val)") + if (AttrVal($name, "dev-h-defExpr", "") ne "ModbusLD_ScanFormat(\$hash, \$val)"); + } + } + #Log3 $name, 5, "$name: ParseObj reading is $reading"; + + if ($reading) { + if ($type =~ "[cd]") { # coils or digital inputs + $unpack = "a"; # for coils just take the next 0/1 from the string + $objLen = 1; # one byte contains one bit from the 01001100 string unpacked above + } else { # holding / input register + #Log3 $name, 5, "$name: ParseObj is getting infos for registers"; + $unpack = Modbus_ObjInfo($logHash, $key, "unpack", "defUnpack", "n"); + $objLen = Modbus_ObjInfo($logHash, $key, "len", "defLen", 1); # default to 1 Reg / 2 Bytes + $encode = Modbus_ObjInfo($logHash, $key, "encode", "defEncode"); # character encoding + $decode = Modbus_ObjInfo($logHash, $key, "decode", "defDecode"); # character decoding + my $revRegs = Modbus_ObjInfo($logHash, $key, "revRegs", "defRevRegs"); # do not reverse register order by default + my $swpRegs = Modbus_ObjInfo($logHash, $key, "bswapRegs", "defBswapRegs"); # dont reverse bytes in registers by default + + $rest = Modbus_RevRegs($logHash, $rest, $objLen) if ($revRegs && $objLen > 1); + $rest = Modbus_SwpRegs($logHash, $rest, $objLen) if ($swpRegs); + }; + $format = Modbus_ObjInfo($logHash, $key, "format", "defFormat"); # no format if nothing specified + $expr = Modbus_ObjInfo($logHash, $key, "expr", "defExpr"); + $ignExpr = Modbus_ObjInfo($logHash, $key, "ignoreExpr", "defIgnoreExpr"); + $map = Modbus_ObjInfo($logHash, $key, "map", "defMap"); # no map if not specified + Log3 $name, 5, "$name: ParseObj ObjInfo for $key: reading=$reading, unpack=$unpack, expr=$expr, format=$format, map=$map"; + + #my $val = unpack ($unpack, $rest); # verarbeite so viele register wie passend (ggf. über mehrere Register) + my @val = unpack ($unpack, $rest); # fill @val array in case $unpack contains codes for more fields, other elements can be used in expr later. + + if (!defined($val[0])) { + my $logLvl = AttrVal($name, "timeoutLogLevel", 3); + Log3 $name, $logLvl, "$name: ParseObj unpack of " . unpack ('H*', $rest) . " with $unpack for $reading resulted in undefined value"; + } else { + # todo: log other array elements + my $vString = ""; + foreach my $v (@val) { + $vString .= ($vString eq "" ? "" : ", ") . ($v =~ /[[:print:]]/ ? $v : "") . " hex " . unpack ('H*', $v); + } + Log3 $name, 5, "$name: ParseObj unpacked " . unpack ('H*', $rest) . " with $unpack to " . $vString; + + for (my $i =0; $i < @val; $i++) { + $val[$i] = decode($decode, $val[$i]) if ($decode); + $val[$i] = encode($encode, $val[$i]) if ($encode); + } + + # Exp zur Ignorieren der Werte? + my $ignore; + $ignore = Modbus_CheckEval($logHash, @val, $ignExpr, "ignoreExpr for $reading") if ($ignExpr); + + # Exp zur Nachbearbeitung der Werte? + my $val = $val[0]; + $val = Modbus_CheckEval($logHash, @val, $expr, "expr for $reading") if ($expr); + + # Map zur Nachbereitung der Werte? + if ($map) { + my $nVal = Modbus_MapConvert ($logHash, $map, $val); + if (defined($nVal)) { + Log3 $name, 5, "$name: ParseObj for $reading maps value $val to $nVal with " . $map; + $val = $nVal + } else { + Log3 $name, 5, "$name: ParseObj for $reading $val does not match map " . $map; + } + } + # Format angegeben? + if ($format) { + Log3 $name, 5, "$name: ParseObj for $reading does sprintf with format " . $format . + ", value is $val"; + $val = sprintf($format, $val); + Log3 $name, 5, "$name: ParseObj for $reading sprintf result is $val"; + } + if ($ignore) { + Log3 $name, 4, "$name: ParseObj for $reading ignores $val because of ignoreExpr. Reading not updated"; + } else { + if ($logHash->{MODE} eq 'slave') { + if (Modbus_ObjInfo($logHash, $key, "allowWrite", "defAllowWrite", 0)) { # write allowed. + my $device = $name; # default device is myself + my $rname = $reading; # given name as reading name + my $dev = $logHash; + if ($rname =~ /^([^\:]+):(.+)$/) { # can we split given name to device:reading? + $device = $1; + $rname = $2; + $dev = $defs{$device}; + } + + my $outOfBounds; + my $setmin = Modbus_ObjInfo($logHash, $key, "min", "", ""); # default to "" + my $setmax = Modbus_ObjInfo($logHash, $key, "max", "", ""); # default to "" + if ($val =~ /^\s*-?\d+\.?\d*\s*$/) { # a number (potentially with blanks) + if ($setmin ne "") { + $val =~ s/\s+//g; + Log3 $name, 5, "$name: parseObj is checking value $val against min $setmin"; + if ($val < $setmin) { + $outOfBounds = 1; + } + } + if ($setmax ne "") { + $val =~ s/\s+//g; + Log3 $name, 5, "$name: set is checking value $val against max $setmax"; + if ($val > $setmax) { + $outOfBounds = 1; + } + } + } + if (!$outOfBounds) { + Log3 $name, 4, "$name: ParseObj assigns value $val to reading $rname of device $device"; + if ($dev eq $logHash) { + readingsBulkUpdate($dev, $rname, $val); # assign value to one of this devices readings + } else { + readingsSingleUpdate($dev, $rname, $val, 1); # assign value to reading - another Fhem device + } + $logHash->{gotReadings}{$reading} = $val; + } else { + Log3 $name, 4, "$name: ParseObj ignores value $val because it is out of bounds ($setmin / $setmax) for reading $rname of device $device"; + my $code = Modbus_DevInfo($logHash, $type, "valueErrCode", 1); + $dataPtr->{ERRCODE} = $code if ($code); + } + } else { + Log3 $name, 4, "$name: ParseObj refuses to set reading $reading (allowWrite not set)"; + my $code = Modbus_DevInfo($logHash, $type, "notAllowedErrCode", 1); + $dataPtr->{ERRCODE} = $code if ($code); + } + } else { + Log3 $name, 4, "$name: ParseObj assigns value $val to $reading"; + readingsBulkUpdate($logHash, $reading, $val); + $logHash->{gotReadings}{$reading} = $val; + $logHash->{lastRead}{$key} = gettimeofday(); # used for pollDelay checking by getUpdate (mode master) + } + } + } + } else { + Log3 $name, 5, "$name: ParseObj has no information about parsing $key"; + $objLen = 1; + if ($logHash->{MODE} eq 'slave') { + my $code = Modbus_DevInfo($logHash, $type, "addressErrCode", 2); + $dataPtr->{ERRCODE} = $code if ($code); + } + } + + # gehe zum nächsten Wert + if ($type =~ "[cd]") { + $startAdr++; + if (length($rest) > 1) { + $rest = substr($rest, 1); + } else { + $rest = ""; + } + last if ($lastAdr && $startAdr > $lastAdr); # only set for unpacked coil / input bit string + } else { + $startAdr += $objLen; + if (length($rest) > ($objLen*2)) { + $rest = substr($rest, $objLen * 2); # take rest of rest starting at len*2 until the end + } else { + $rest = ""; + } + } + Log3 $name, 5, "$name: ParseObj moves to next object, skip $objLen to $type$startAdr" if ($rest); + } + readingsEndUpdate($logHash, 1); + return; +} + + + +############################################### +# call parse request, get logical device responsible +# write / read data as requested +# call send response +# +# when called we have $hash->{FRAME}{MODBUSID}, $hash->{FRAME}{FCODE}, $hash->{FRAME}{DATA} +# and for TCP also $hash->{FRAME}{PDULEXP} and $hash->{FRAME}{TID} +# +# return undef if read should continue reading +# or 1 if we can react on data that was read + +sub Modbus_HandleRequest($) +{ + my ($hash) = @_; + my $name = $hash->{NAME}; # name of physical device + my $frame = $hash->{FRAME}; + my $id = $frame->{MODBUSID}; + my $fCode = $frame->{FCODE}; + my $logHash; + + Log3 $name, 5, "$name: HandleRequest called from " . Modbus_Caller(); + + my %requestData; # create new request structure + my $request = \%requestData; + + if (!Modbus_ParseRequest($hash, $request)) { + Log3 $name, 5, "$name: HandleRequest could not parse request frame yet, wait for more data"; + return; + } + # for unknown fCode $request->{ERRCODE} as well as {ERROR} are set by ParseRequest, later CreateResponse copies ERRCODE from Request into Response + + $hash->{REQUEST} = $request; + my $frameLen = $frame->{PDULEXP} + $Modbus_PDUOverhead{$hash->{PROTOCOL}}; + my $readLen = length($hash->{READ}{BUFFER}); + + #Log3 $name, 5, "$name: HandleRequest is now calling CheckChecksum"; + Modbus_CheckChecksum($hash); # get $hash->{FRAME}{CHECKSUMCALC}, $hash->{FRAME}{CHECKSUMSENT} and $hash->{FRAME}{CHECKSUMERROR} + + if ($frame->{CHECKSUMERROR}) { # ignore frame->{ERROR} here since the ony other possible error is unsupported fCode which should create a response + if ($readLen < $frameLen ) { + Log3 $name, 5, "$name: HandleRequest did not get a valid frame yet, wait for more data"; + return; # frame not complete and error - continue reading + } else { + Modbus_RequestDone($hash, 4); # log, profiler, drop data + return 1; # error or not, parsing is done. + } + } else { + if ($readLen < $frameLen ) { + Log3 $name, 5, "$name: HandleRequest got valid checksum but short frame."; + return; + } + # got a valid frame - maybe we can't handle it (unsupported fCode -> ERRCODE) + Modbus_Profiler($hash, "Fhem"); + Modbus_LogFrame($hash, "HandleRequest", 5); + + # look for Modbus logical device with the right ID. (slave or relay) + $logHash = Modbus_GetLogHash($hash, $id); + + if ($logHash) { # our id, we are responsible + $request->{DEVHASH} = $logHash; + if ($hash->{MODE} eq 'slave') { + if (!$request->{ERRCODE} && $writeCode{$fCode}) { # supported write fCode request contains data to be parsed and stored + # parse the request value, set reading with formatting etc. like for replies + Log3 $name, 5, "$name: passing value string of write request to ParseObj to set readings"; + # we don't pass length here but check definitions and allowance for each register / len defined by attributes starting at adr + + my $parseLogHash1 = ($logHash->{CHILDOF} ? $logHash->{CHILDOF} : $logHash); + my $pName = $parseLogHash1->{NAME}; + ModbusLD_ParseObj($parseLogHash1, $request); + # parseObj can also set ERRCODE (illegal address, value out of bounds) + # so CreateResponse/PackResponse will create an error message back to master + Log3 $pName, 5, "$pName: HandleRequest got " . scalar keys (%{$parseLogHash1->{gotReadings}}) . " readings from ParseObj"; + } + } + } else { + Log3 $name, 4, "$name: $id is not one of our Modbus Ids"; + } + } + if ($logHash) { + if ($hash->{MODE} eq 'slave') { + Modbus_CreateResponse($hash); # data or unsupported fCode error if request->{ERRCODE} and {ERROR} were set during parse + } elsif ($hash->{MODE} eq 'relay') { + Modbus_RelayRequest($hash, $frame); # even if unspoorted fCode ... + } + } + Modbus_RequestDone($hash, 4); # log, profiler, drop data + return 1; # error or not, parsing is done. +} + + + + +# handle Passive +# +# Zustands var lesen Request oder Response +# lese request wie bei slave, +# lese response wie bei Master, bei Timeout wieder auf Request warten +# +# problem: was kommt gerade? +# +# + + + +# Mode master: +# create request structure -> queue -> send +# read response, parse to frame, response structure, parse data -> readings +# +# Mode slave: +# read request, parse request structure -> set readings for write requests, get values for read requests as data string +# create response pdu, pack frame and send +# +# Mode passive: +# read request, parse request structure, +# read response, parse to frame, response structure, parse data -> readings +# +# Mode relay (if mode at all) needs two active connections! +# read request, parse request structure +# pass to Master device -> queue -> send +# read response, parse to frame, pdu (response structure not needed here) +# take response pdu, pack frame and send +# + + +# +# Parse Request, called from handleRequest +# +# require $physHash->{FRAME} to be filled before by HandleFrameStart +# +####################################################################### +sub Modbus_ParseRequest($$) +{ + my ($hash, $request) = @_; + my $name = $hash->{NAME}; + my $frame = $hash->{FRAME}; + return if (!$frame->{FCODE}); + my $fCode = $frame->{FCODE}; # filled in handleFrameStart + my $data = $frame->{DATA}; + + Log3 $name, 5, "$name: ParseRequest called from " . Modbus_Caller(); + + use bytes; + my $dataLength = length($data); + $request->{FCODE} = $frame->{FCODE}; + $request->{MODBUSID} = $frame->{MODBUSID}; + $request->{TID} = $frame->{TID} if ($frame->{TID}); + + if ($fCode == 1 || $fCode == 2) { + # read coils / discrete inputs, pdu: fCode, StartAdr, Len (=number of coils) + return if ($dataLength) < 4; + my ($adr, $len) = unpack ('nn', $data); + $request->{TYPE} = ($fCode == 1 ? 'c' : 'd'); # coils or discrete inputs + $request->{ADR} = $adr; # 16 Bit Coil / Input adr + $request->{LEN} = $len; # 16 Bit number of Coils / Inputs + $frame->{PDULEXP} = 5; # fCode + 2x16Bit + + } elsif ($fCode == 3 || $fCode == 4) { + # read holding/input registers, pdu: fCode, StartAdr, Len (=number of regs) + return if ($dataLength) < 4; + my ($adr, $len) = unpack ('nn', $data); + $request->{TYPE} = ($fCode == 3 ? 'h' : 'i'); # holding registers / input registers + $request->{ADR} = $adr; # 16 Bit Coil / Input adr + $request->{LEN} = $len; # 16 Bit number of Coils / Inputs + $frame->{PDULEXP} = 5; # fCode + 2x16Bit + + } elsif ($fCode == 5) { + # write single coil, pdu: fCode, StartAdr, Value (1-bit as FF00) + return if ($dataLength) < 4; + my ($adr, $value) = unpack ('na*', $data); + $request->{TYPE} = 'c'; # coil + $request->{ADR} = $adr; # 16 Bit Coil adr + $request->{LEN} = 1; + $request->{VALUES} = $value; + $frame->{PDULEXP} = 5; # fCode + 2 16Bit Values + + } elsif ($fCode == 6) { + # write single holding register, pdu: fCode, StartAdr, Value + return if ($dataLength) < 4; + my ($adr, $value) = unpack ('na*', $data); + $request->{TYPE} = 'h'; # holding register + $request->{ADR} = $adr; # 16 Bit holding register adr + $request->{LEN} = 1; + $request->{VALUES} = $value; + $frame->{PDULEXP} = 5; # fCode + 2x16Bit + + } elsif ($fCode == 15) { + # write multiple coils, pdu: fCode, StartAdr, NumOfCoils, ByteCount, Values as bits + return if ($dataLength) < 6; + my ($adr, $len, $bytes, $values) = unpack ('nnCa*', $data); + $request->{TYPE} = 'c'; # coils + $request->{ADR} = $adr; # 16 Bit Coil adr + $request->{LEN} = $len; + $request->{VALUES} = $values; + $frame->{PDULEXP} = 6 + $bytes; # fCode + 2x16Bit + bytecount + values + + } elsif ($fCode == 16) { + # write multiple regs, pdu: fCode, StartAdr, NumOfRegs, ByteCount, Values + my ($adr, $len, $bytes, $values) = unpack ('nnCa*', $data); + return if ($dataLength) < 6; + $request->{TYPE} = 'h'; # coils + $request->{ADR} = $adr; # 16 Bit Coil adr + $request->{LEN} = $len; + $request->{VALUES} = $values; + $frame->{PDULEXP} = 6 + $bytes; # fCode + 2x16Bit + bytecount + values + + } else { # function code not implemented yet + $request->{ERRCODE} = 1; # error code 1 in Modbus response = illegal function + Modbus_AddFrameError($frame, "Function code $fCode not implemented"); + $frame->{PDULEXP} = 2; + } + $request->{PDU} = pack ('C', $fCode) . substr($data, 0, $frame->{PDULEXP}); + return 1; # continue handling / dropping this frame +} + + + +####################################################### +# get the valid io device for the relay forward device +# called with the logical device hash of a relay +# this relay device hash has hash->{RELAY} set to the name of the forward device +# also sets $hash->{RELID} (in the logical relay device) +# to the Modbus id of the relay forward device +sub Modbus_GetRelayIO($) +{ + my ($hash) = @_; + my $name = $hash->{NAME}; + my $reName; + my $reHash; + my $reIOHash; + my $msg; + + if (!$hash->{RELAY}) { + $msg = "GetRelay doesn't have a relay forward device"; + } else { + $reName = $hash->{RELAY}; # name of the relay forward device as defined + $reHash = $defs{$reName}; + #Log3 $name, 5, "$name: GetRelayIO for relay forward device $reHash->{NAME}"; + if (!$reHash || !$reHash->{MODULEVERSION} || + $reHash->{MODULEVERSION} !~ /^Modbus / || $reHash->{MODE} ne 'master' + || $reHash->{TYPE} eq 'Modbus') { + $msg = "relay forward device $reName is not a modbus master"; + } else { + # now we have a $reHash for the logical relay device at least + $reIOHash = ModbusLD_GetIOHash($reHash); # get io device hash of the relay forward device + my $slIOHash = ModbusLD_GetIOHash($hash); # get io device hash of the relay slave part. Check later if available + if (!$reIOHash) { + $msg = "no relay forward io device"; + } elsif ($reIOHash eq $slIOHash) { + $msg = "relay forward io device must not must not be same as receiving device"; + } else { + # now check for disabled devices + $msg = ModbusLD_CheckDisable($reHash); # is relay forward device or its io device disabled? + } + } + } + # don't check if relay io device is actually opened. This will be done when the queue is processed + if ($msg) { + Log3 $name, 3, "$name: GetRelayIO: $msg"; + delete $hash->{RELID}; + return; + } + $hash->{RELID} = $reHash->{MODBUSID}; + Log3 $name, 5, "$name: GetRelayIO found $reIOHash->{NAME} as Modbus relay forward io device"; + return $reIOHash; +} + + +############################################# +# relay request to the specified relay device +sub Modbus_RelayRequest($$) +{ + my ($hash, $frame) = @_; + my $name = $hash->{NAME}; # the io device of the device defined with MODE relay (received the request) + my $request = $hash->{REQUEST}; + my $slHash = $request->{DEVHASH}; # the logical device with MODE relay (that handled the incoming request) + + Log3 $name, 5, "$name: RelayRequest called from " . Modbus_Caller(); + + my $reIOHash = Modbus_GetRelayIO($slHash); # the io device of the relay forward device (relay to) + + if (!$reIOHash) { + Modbus_AddFrameError($frame, "relay device unavailable"); + $request->{ERRCODE} = 10; # gw path unavail; 11=gw target fail to resp. + Modbus_CreateResponse($hash); # error response with request data and errcode + } else { + my $id = $slHash->{RELID}; + my %fRequest = %{$request}; # create a copy to modify and forward + # (DEVHASH stays the logical device that received the incoming request) + Modbus_LogFrame($hash, "RelayRequest via $reIOHash->{NAME}, Proto $reIOHash->{PROTOCOL} with id $id", 4); + if ($reIOHash->{PROTOCOL} eq 'TCP') { # forward as Modbus TCP? + my $tid = int(rand(255)); + $fRequest{TID} = $tid; # new transaction id for Modbus TCP forwarding + } + $fRequest{MODBUSID} = $id; # Modified target ID for the request to forward + Modbus_QueueRequest($reIOHash, \%fRequest, 0); # dont't force, just queue + $hash->{EXPECT} = "waitrelay" # wait for relay response to then send our response + } +} + + + +########################################## +# relay response back to the device that +# sent the original request. We are master +sub Modbus_RelayResponse($) +{ + my ($hash) = @_; + my $name = $hash->{NAME}; # physical device that received response + my $response = $hash->{RESPONSE}; # response for the request we did pass on + + my $slHash = $response->{DEVHASH}; # hash of logical relay device that got the first request + my $ioHash = ModbusLD_GetIOHash($slHash); # the ioHash that received the original request + if (!$ioHash) { + Log3 $name, 4, "$name: relaying response back failed because slave side io device disappeared"; + return; + } + my $request = $ioHash->{REQUEST}; # original request to relay + + # adjust Modbus ID for back communication + $response->{MODBUSID} = $request->{MODBUSID} if ($request->{MODBUSID}); + $response->{TID} = $request->{TID} if ($request->{TID}); + Modbus_LogFrame($slHash, "RelayResponse via $slHash->{NAME}, ioDev $slHash->{IODev}{NAME}", 4, $request, $response); + + my $responseFrame = Modbus_PackFrame($ioHash, $request->{MODBUSID}, $response->{PDU}, $request->{TID}); + Modbus_Send($ioHash, $request->{MODBUSID}, $responseFrame, $slHash); + Modbus_Profiler($hash, "Wait"); + return; +} + + +######################################### +# called from HandleRequest, RelayRequest +# and responseTimeout (when a relay wants to +# inform its master about the downstream timeout) +# +# the start adr and length of the request is +# taken to assemble a response frame out of +# one or several objects +# + +sub Modbus_CreateResponse($) +{ + my ($hash) = @_; + my $request = $hash->{REQUEST}; + my $logHash = $request->{DEVHASH}; + + $logHash = $logHash->{CHILDOF} if ($logHash->{CHILDOF}); + my $name = $logHash->{NAME}; # name of logical device + + Log3 $name, 5, "$name: CreateResponse called from " . Modbus_Caller(); + + my %responseData; + my $response = \%responseData; + $hash->{RESPONSE} = $response; + + # get values for response + $response->{ADR} = $request->{ADR}; + $response->{LEN} = $request->{LEN}; + $response->{TYPE} = $request->{TYPE}; + $response->{MODBUSID} = $request->{MODBUSID}; + $response->{FCODE} = $request->{FCODE}; + $response->{TID} = $request->{TID} if ($request->{TID}); + $response->{ERRCODE} = $request->{ERRCODE}; + + # pack one or more values into a vales string + $response->{VALUES} = ModbusLD_PackObj($logHash, $response) if (!$response->{ERRCODE}); + + Log3 $name, 5, "$name: prepare response pdu"; + my $responsePDU = Modbus_PackResponse($hash, $response); # creates response or error PDU Data if {ERRCODE} is set + + # pack and send + my $responseFrame = Modbus_PackFrame($hash, $response->{MODBUSID}, $responsePDU, $response->{TID}); + + Log3 $name, 4, "$name: CreateResponse sends " . + ($response->{ERRCODE} ? + "fc " . ($response->{FCODE} + 128) . " error code $response->{ERRCODE}" : + "fc $response->{FCODE}") . + " to id $response->{MODBUSID}, " . + ($response->{TID} ? "tid $response->{TID} " : "") . + "for $response->{TYPE} $response->{ADR}, len $response->{LEN}" . + ", device $name ($hash->{PROTOCOL}), pdu " . + unpack ('H*', $responsePDU) . ", V $Modbus_Version"; + + # todo: logHash passed to send is used to set lsend. For TCP connected master devices this is irrelevant + # only for connected slaves this should be checked / set + + Modbus_Send($hash, $response->{MODBUSID}, $responseFrame, $logHash); + Modbus_Profiler($hash, "Idle"); +} + + + +############################################################## +# called from logical device functions +# get, set, scan etc. with log dev hash, create request +# and call QueueRequest +sub ModbusLD_DoRequest($$$;$$$){ + my ($hash, $objCombi, $op, $v1, $force, $reqLen) = @_; + # $hash : the logical device hash + # $objCombi : type+adr + # $op : read, write or scanids/scanobj + # $v1 : value for writing (already packed, also for coil ff00 or 0000) + # $force : put in front of queue and don't reschedule but wait if necessary + + my $name = $hash->{NAME}; # name of logical device + my $devId = ($op =~ /^scanid([0-9]+)/ ? $1 : $hash->{MODBUSID}); + my $proto = $hash->{PROTOCOL}; + my $type = substr($objCombi, 0, 1); + my $adr = substr($objCombi, 1); + my $reading = Modbus_ObjInfo($hash, $objCombi, "reading"); + my $objLen = Modbus_ObjInfo($hash, $objCombi, "len", "defLen", 1); + my $fcKey = $op; + if ($op =~ /^scan/) { + $objLen = $reqLen; # for scan there is no objLen but reqLen is given - avoid confusing log and set objLen ... + $fcKey = 'read'; + } + + Log3 $name, 5, "$name: DoRequest called from " . Modbus_Caller(); + my $ioHash = ModbusLD_GetIOHash($hash); # send queue is at physical hash + my $qlen = ($ioHash->{QUEUE} ? scalar(@{$ioHash->{QUEUE}}) : 0); + + #Log3 $name, 4, "$name: DoRequest called from " . Modbus_Caller() . " with $type$adr, objLen $objLen / reqLen " . + ($reqLen ? $reqLen : "-") . " to id $devId, op $op, qlen $qlen" . + ((defined($v1) && $op eq 'write') ? ", value hex " . unpack ('H*', $v1) : ""); + $reqLen = $objLen if (!$reqLen); # combined reqLen from GetUpdate or scans + + return if (ModbusLD_CheckDisable($hash)); # returns if there is no io device + + # check if defined unpack code matches a corresponding len and log warning if appropriate + my $unpack = Modbus_ObjInfo($hash, $objCombi, "unpack", "defUnpack", "n"); + if ($objLen < 2 && $unpack =~ /lLIqQfFNVD/) { + Log3 $name, 3, "$name: DoRequest with unpack $unpack but len seems too small - please set obj-${objCombi}-Len!"; + } + + my $defFC = $Modbus_defaultFCode{$type}{$fcKey}; + $defFC = 16 if ($defFC == 6 && $reqLen > 1); + my $fCode = Modbus_DevInfo($hash, $type, $fcKey, $defFC); + if (!$fCode) { + Log3 $name, 3, "$name: DoRequest did not find fCode for $fcKey type $type"; + return; + } elsif ($fCode == 6 && $reqLen > 1) { + Log3 $name, 3, "$name: DoRequest tries to use function code 6 to write more than one register. This will not work" + } + my %request; + $request{FCODE} = $fCode; # function code + $request{DEVHASH} = $hash; # logical device in charge + $request{TYPE} = $type; # type of object (cdih) + $request{ADR} = $adr; # address of object + $request{LEN} = $reqLen; # number of registers / length of object + $request{READING} = $reading; # reading name of the object + $request{MODBUSID} = $devId; # ModbusId of the addressed device - coming from logical device hash + $request{VALUES} = $v1; # Value to be written (from set, already packed, even for coil a packed 0/1) + $request{OPERATION} = $op; # read / write / scan + + if ($proto eq "TCP") { + my $tid = int(rand(255)); + $request{TID} = $tid; # transaction id for Modbus TCP + } + delete $ioHash->{RETRY}; + + #$ioHash->{REQUEST} = \%request; # It might overwrite the one sent -> dont link here + Modbus_LogFrame($hash, "DoRequest (called from " . Modbus_Caller() . ") created", 4, \%request); + Modbus_QueueRequest($ioHash, \%request, $force); +} + + + +##################################### +# called from CreateRequest +# with physical device hash +sub Modbus_QueueRequest($$$){ + my ($hash, $request, $force) = @_; + # $hash : the physical device hash + # $force : put in front of queue and don't reschedule but sleep if necessary + + my $name = $hash->{NAME}; # name of physical device with the queue + my $qlen = ($hash->{QUEUE} ? scalar(@{$hash->{QUEUE}}) : 0); + my $lqMax = ($request->{DEVHASH} ? AttrVal($request->{DEVHASH}{NAME}, "queueMax", 100) : 100); + my $qMax = AttrVal($name, "queueMax", $lqMax); + + Log3 $name, 5, "$name: QueueRequest called from " . Modbus_Caller() . + " with $request->{TYPE}$request->{ADR}, qlen $qlen"; + + return if (ModbusLD_CheckDisable($hash)); # also returns if there is no io device + + # check for queue doubles if not forcing + if ($qlen && AttrVal($name, "dropQueueDoubles", 0) && !$force) { + Log3 $name, 5, "$name: QueueRequest is checking if request for $request->{TYPE}$request->{ADR} is already in queue (len $qlen)"; + foreach my $elem (@{$hash->{QUEUE}}) { + #Log3 $name, 5, "$name: QueueRequest checks $elem->{TYPE}$elem->{ADR} reqLen $elem->{LEN} to id $elem->{MODBUSID}?"; + if($elem->{ADR} == $request->{ADR} && $elem->{TYPE} eq $request->{TYPE} + && $elem->{LEN} == $request->{LEN} && $elem->{MODBUSID} eq $request->{MODBUSID}) { + Log3 $name, 4, "$name: QueueRequest found request already in queue - dropping"; + return; + } + } + } + my $now = gettimeofday(); + $request->{TIMESTAMP} = $now; + if(!$qlen) { + #Log3 $name, 5, "$name: QueueRequest is creating new queue"; + $hash->{QUEUE} = [ $request ]; + } else { + #Log3 $name, 5, "$name: QueueRequest initial queue length is $qlen"; + if ($qlen > $qMax) { + Log3 $name, 3, "$name: QueueRequest queue too long ($qlen), dropping new request"; + } else { + if ($force) { + unshift (@{$hash->{QUEUE}}, $request); # prepend at beginning + } else { + push(@{$hash->{QUEUE}}, $request); # add to end of queue + } + } + } + if ($hash->{EXPECT} ne 'response' || $force) { # even process queue diretly if force or not busy + Modbus_ProcessRequestQueue("direct:".$name, $force); # call directly - even wait if force is set + } else { + readingsSingleUpdate($hash, "QueueLength", ($hash->{QUEUE} ? scalar(@{$hash->{QUEUE}}) : 0), 1) if (AttrVal($name, "enableQueueLengthReading", 0)); + Modbus_StartQueueTimer($hash); # make sure timer is set + } + return; +} + + + +####################################### +# prüfe delays vor dem Senden +sub Modbus_CheckDelay($$$$$$) +{ + my ($ioHash, $devName, $force, $title, $delay, $last) = @_; + return if (!$delay); + my $now = gettimeofday(); + my $name = $ioHash->{NAME}; + my $t2 = $last + $delay; + my $rest = $t2 - $now; + + my $logMsg = "$name: CheckDelay called from " . Modbus_Caller() . + " $title (${delay}s since " . Modbus_FmtTime($last) . ")" . + #" for $devName, now is " . Modbus_FmtTime($now) . + " for $devName" . + ($rest >=0 ? ", rest " . sprintf ("%.3f", $rest) : ", delay over"); + + if ($rest > 0) { + Modbus_Profiler($ioHash, "Delay"); + if ($force) { + Log3 $name, 4, $logMsg . ", sleep forced"; + sleep $rest if ($rest > 0 && $rest < $delay); + return 0; + } else { + Log3 $name, 4, $logMsg . ", set timer to try again later"; + Modbus_StartQueueTimer($ioHash, $rest); # call processRequestQueue when remeining delay is over + return 1; + } + } else { + Log3 $name, 5, $logMsg; + } + return 0; +} + + + +# stopQueueTimer is called: +# - at the end of open and close (initialized state, queue should be empty) +# - when queue becomes empty while processing the queue +# when processRequestQueue gets called from fhem.pl via internal timer, this timer is removed internally -> nextQueueRun deleted + +# startQueueTimer is called +# - in queueRequest when something got added to the queue +# - end of get to set it to immediate processing +# - end of set to set it to immediate processing +# - in read after HandleResponse has done something to start immediate processing +# - in processRequestQueue to set a new delay +# - in checkDelay called from processRequestQueue +# before it returns 1 (to ask the caller to return because delay is not over yet) + +# but startQueueTimer does only set the timer if the queue contains something + +# processRequestQueue or startQueueTimer is not called in ResponseDone because +# when ResponseDone is called from read, startQueueTimer is called in read after HandleResponse +# when ResponseDone is called from readAnswer, readAnswer returns to get/set who call stertQueueTimer at the end + + + +###################################################### +# set internal timer for next queue processing +# to now + passed delay (if delay is passed) +# if no delay is passed, use attribute queueDelay if no shorter timer is already set +sub Modbus_StartQueueTimer($;$) +{ + my ($ioHash, $pDelay) = @_; + my $name = $ioHash->{NAME}; + my $qlen = ($ioHash->{QUEUE} ? scalar(@{$ioHash->{QUEUE}}) : 0); + if ($ioHash->{MODE} && $ioHash->{MODE} eq 'master' && $qlen) { + my $now = gettimeofday(); + my $delay = (defined($pDelay) ? $pDelay : AttrVal($name, "queueDelay", 1)); + if ($ioHash->{nextQueueRun} && $ioHash->{nextQueueRun} < $now+$delay && !defined($pDelay)) { + my $remain = $ioHash->{nextQueueRun} - $now; + $remain = 0 if ($remain < 0); + Log3 $name, 5, "$name: StartQueueTimer called form " . Modbus_Caller() . + " has already set internal timer to call Modbus_ProcessRequestQueue in " . + sprintf ("%.3f", $remain) . " seconds"; + return; + } + RemoveInternalTimer ("queue:$name"); + InternalTimer($now+$delay, "Modbus_ProcessRequestQueue", "queue:$name", 0); + $ioHash->{nextQueueRun} = $now+$delay; + Log3 $name, 5, "$name: StartQueueTimer called form " . Modbus_Caller() . + " sets internal timer to call Modbus_ProcessRequestQueue in " . + sprintf ("%.3f", $delay) . " seconds"; + } else { + RemoveInternalTimer ("queue:$name"); + delete $ioHash->{nextQueueRun}; + Log3 $name, 5, "$name: StartQueueTimer called from " . Modbus_Caller() . + " removes internal timer because it is not needed now"; + } +} + + +###################################################### +# remove internal timer for next queue processing +sub Modbus_StopQueueTimer($) +{ + my ($ioHash) = @_; + my $name = $ioHash->{NAME}; + if ($ioHash->{MODE} && $ioHash->{MODE} eq 'master' && $ioHash->{nextQueueRun}) { + RemoveInternalTimer ("queue:$name"); + delete $ioHash->{nextQueueRun}; + Log3 $name, 5, "$name: StopQueueTimer called from " . Modbus_Caller() . + " removes internal timer to call Modbus_ProcessRequestQueue"; + } +} + + +####################################### +# Aufruf aus InternalTimer mit "queue:$name" +# oder direkt mit "direkt:$name +# wobei name das physical device ist +# greift über den Request der Queue auf das logische Device zu +# um Timings und Zeitstempel zu verarbeiten +# setzt selbst wieder einen Timer nach qDelay (default 1 Sek) +# nach erfolgreichem Lesen einer response als Master wird HandleResponseQueue direkt aufgerufen +# nach einem Timeout wird ebenso direkt aufgerufen. + +# to be able to open tcp connections on demand and close them after communication +# ProcessRequestQueue should call open if necessary and then return / set timer with queueDelay +# to try again in x seconds. +# then the queue entries should have their own timeout so they can get removed e.g. after 10 seconds +# otherwise the queue will overflow sometimes. +# the age of entries is checked here and the entry removed if it is too old. +sub Modbus_ProcessRequestQueue($;$) +{ + my ($ckey,$name) = split(':', shift); + my $force = shift; # sleep if necessary, force sending now! + my $ioHash = $defs{$name}; + my $queue = $ioHash->{QUEUE}; + my $now = gettimeofday(); + my $qDelay = AttrVal($name, "queueDelay", 1); + my $qTo = AttrVal($name, "queueTimeout", 20); + my $request; + + Log3 $name, 5, "$name: ProcessRequestQueue called from " . Modbus_Caller() . " as $ckey:$name" . ($force ? ", force" : ""); + delete $ioHash->{nextQueueRun}; # internal timer has fired / called us -> clean up + + for(;;) { # get first usable entry + if(!$queue || !scalar(@{$queue})) { # nothing in queue -> return + Log3 $name, 5, "$name: ProcessRequestQueue has nothing in queue"; + readingsSingleUpdate($ioHash, "QueueLength", 0, 1) if (AttrVal($name, "enableQueueLengthReading", 0)); + return; + } + $request = $queue->[0]; # get top element from Queue + if ($request && $request->{FCODE}) { # valid entry? + $request->{TIMESTAMP} = $now if (!$request->{TIMESTAMP}); # should never happen + last if ($now - $request->{TIMESTAMP} <= $qTo); # element is not outdated -> exit loop + } + shift(@{$queue}); # remove invalid first element from queue and iterate + } + # now a valid element is at the top of the queue + + my $qlen = ($queue ? scalar(@{$queue}) : 0); # can not be 0 now, otherwise would have returned above + my $logHash = $request->{DEVHASH}; + my $msg = ModbusLD_CheckDisable($logHash); + if ($msg) { # logical or physical device is disabled, already logged by CheckDisable + $msg = "dropping queue because logical or io device is disabled"; + delete $ioHash->{QUEUE}; # drop whole queue + } elsif (!DevIo_IsOpen($ioHash)) { + $msg = "device is disconnected"; + Modbus_Open($ioHash); # try to open asynchronously so we can proceed after qDelay + # todo: this calls close and with that stops the update timer! -> set it again when reconnected. + + } elsif (!$init_done) { # fhem not initialized, wait with IO + $msg = "device is not available yet (init not done)"; + } elsif ($ioHash->{MODE} && $ioHash->{MODE} ne 'master') { + $msg = "dropping queue because device is not in mode master"; + delete $ioHash->{QUEUE}; # drop whole queue + } elsif ($ioHash->{EXPECT} eq 'response') { # still busy waiting for response to last request + $msg = "Fhem is still waiting for response"; + } + readingsSingleUpdate($ioHash, "QueueLength", ($queue ? scalar(@{$queue}) : 0), 1) if (AttrVal($name, "enableQueueLengthReading", 0)); + if ($msg) { + Modbus_Profiler($ioHash, "Idle") if ($ioHash->{EXPECT} ne 'response'); + Log3 $name, 5, "$name: ProcessRequestQueue called from " . Modbus_Caller() . " returns, $msg, " . + "qlen $qlen, try again in $qDelay seconds"; + Modbus_StartQueueTimer($ioHash); # try again after qDelay, no shorter waiting time obvious + return; + } + + # check defined delays + my $reqId = $request->{MODBUSID}; + if ($ioHash->{REMEMBER}{lrecv}) { + #Log3 $name, 5, "$name: ProcessRequestQueue check busDelay ..."; + return if (Modbus_CheckDelay($ioHash, $name, $force, + "busDelay", AttrVal($name, "busDelay", 0), + $ioHash->{REMEMBER}{lrecv})); # Profiler set to Delay, queue timer is set accordingly + + #Log3 $name, 5, "$name: ProcessRequestQueue check clientSwitchDelay ..."; + my $clSwDelay = AttrVal($name, "clientSwitchDelay", 0); + if ($clSwDelay && $ioHash->{REMEMBER}{lid} + && $reqId != $ioHash->{REMEMBER}{lid}) { + return if (Modbus_CheckDelay($ioHash, $name, $force, + "clientSwitchDelay", $clSwDelay, + $ioHash->{REMEMBER}{lrecv})); # Profiler set to Delay, queue timer is set accordingly + } + } + if ($logHash->{REMEMBER}{lrecv}) { + return if (Modbus_CheckDelay($ioHash, $logHash->{NAME}, $force, + "commDelay", Modbus_DevInfo($logHash, "timing", "commDelay", 0.1), + $logHash->{REMEMBER}{lrecv})); # Profiler set to Delay, queue timer is set accordingly + } + if ($logHash->{REMEMBER}{lsend}) { + return if (Modbus_CheckDelay($ioHash, $logHash->{NAME}, $force, + "sendDelay", Modbus_DevInfo($logHash, "timing", "sendDelay", 0.1), + $logHash->{REMEMBER}{lsend})); # Profiler set to Delay, queue timer is set accordingly + } + + my $pdu = Modbus_PackRequest($ioHash, $request); + Log3 $name, 4, "$name: ProcessRequestQueue got pdu from PackRequest: " . unpack 'H*', $pdu; + + my $frame = Modbus_PackFrame($ioHash, $reqId, $pdu, $request->{TID}); + + Modbus_LogFrame ($ioHash, "ProcessRequestQueue (V$Modbus_Version) sending", 4, $request); + + $request->{FRAME} = $frame; # frame as data string for echo detection + $ioHash->{REQUEST} = $request; # save for later + $ioHash->{EXPECT} = 'response'; # expect to read a response + + $ioHash->{READ}{BUFFER} = ""; # clear Buffer for next reception + + Modbus_Statistics($ioHash, "Requests", 1); + Modbus_Send($ioHash, $reqId, $frame, $logHash); + Modbus_Profiler($ioHash, "Wait"); + + # todo: put in "setTimeoutTimer" function + my $timeout = Modbus_DevInfo($logHash, "timing", "timeout", 2); + my $toTime = $now+$timeout; + RemoveInternalTimer ("timeout:$name"); + InternalTimer($toTime, "Modbus_ResponseTimeout", "timeout:$name", 0); + $ioHash->{nextTimeout} = $toTime; # to be able to calculate remaining timeout time in ReadAnswer + + shift(@{$queue}); # remove first element from queue + readingsSingleUpdate($ioHash, "QueueLength", ($queue ? scalar(@{$queue}) : 0), 1) if (AttrVal($name, "enableQueueLengthReading", 0)); + Modbus_StartQueueTimer($ioHash); # schedule next call if there are more items in the queue + return; +} + + +########################################################### +# Pack holding / input register / coil Data for a response, +# only called from createResponse which is only called from HandleRequest +# with logical device hash and the response hash + +# two lengths: +# one (valuesLen) from the response hash LEN (copied from the request length) +# and one (len) from the objInfo for the current object +# + +sub ModbusLD_PackObj($$) { + my ($logHash, $response) = @_; + my $name = $logHash->{NAME}; + + my $valuesLen = $response->{LEN}; # length of the values string requested + my $type = $response->{TYPE}; # object to start with + my $startAdr = $response->{ADR}; + + my $lastAdr = ($valuesLen ? $startAdr + $valuesLen -1 : 0); + my $data = ""; + my $counter = 0; + + #Log3 $name, 5, "$name: PackObj called from " . Modbus_Caller(); + Log3 $name, 5, "$name: PackObj called from " . Modbus_Caller() . " with $type $startAdr" . + ($valuesLen ? " and valuesLen $valuesLen" : ""); + $valuesLen = 1 if (!$valuesLen); + use bytes; + + while ($counter < $valuesLen) { + # einzelne Felder verarbeiten + my $key = $type . $startAdr; + my $reading = Modbus_ObjInfo($logHash, $key, "reading"); # is data coming from a reading + my $expr = Modbus_ObjInfo($logHash, $key, "setexpr", "defSetexpr"); # or a setexpr (convert to register data) + my $format = Modbus_ObjInfo($logHash, $key, "format", "defFormat"); # no format if nothing specified + my $map = Modbus_ObjInfo($logHash, $key, "map", "defMap"); # no map if not specified + my $unpack = Modbus_ObjInfo($logHash, $key, "unpack", "defUnpack", "n"); + my $len = Modbus_ObjInfo($logHash, $key, "len", "defLen", 1); # default to 1 Reg / 2 Bytes + my $decode = Modbus_ObjInfo($logHash, $key, "decode", "defDecode"); # character decoding + my $encode = Modbus_ObjInfo($logHash, $key, "encode", "defEncode"); # character encoding + my $revRegs = Modbus_ObjInfo($logHash, $key, "revRegs", "defRevRegs"); # do not reverse register order by default + my $swpRegs = Modbus_ObjInfo($logHash, $key, "bswapRegs", "defBswapRegs"); # dont reverse bytes in registers by default + + if (!$reading && !$expr) { + Log3 $name, 5, "$name: PackObj doesn't have reading or expr information for $key, set error code to 2"; + my $code = Modbus_DevInfo($logHash, $type, "addressErrCode", 2); + if ($code) { + $response->{ERRCODE} = $code; # if set, packResponse will not use values string + return 0; + } + } else { + Log3 $name, 5, "$name: PackObj ObjInfo for $key: reading=$reading, expr=$expr, format=$format, len=$len, map=$map, unpack=$unpack"; + } + + my $val = 0; + # value from defined reading + if ($reading) { # Reading as source of value + my $device = $name; # default device is myself + my $rname = $reading; # given name as reading name + if ($rname =~ /^([^\:]+):(.+)$/) { # can we split given name to device:reading? + $device = $1; + $rname = $2; + } + $val = ReadingsVal($device, $rname, ""); + Log3 $name, 4, "$name: PackObj for $key is using reading $rname of device $device with value $val"; + } + + # expression + if ($expr) { # expr as source or manipulation of value + my @val = ($val); + $val = Modbus_CheckEval($logHash, @val, $expr, "expression for $key"); + Log3 $name, 5, "$name: PackObj for $key converted value with setexpr $expr to $val"; + } + + # format + if ($format) { # format given? + $val = sprintf($format, $val); + Log3 $name, 5, "$name: PackObj for $key formats value with sprintf $format to $val"; + } + + # map + if ($map) { + my $newVal = Modbus_MapConvert ($logHash, $map, $val, 1); # use reversed map + return "value $val did not match defined map" if (!defined($val)); + $val = $newVal; + } + + # encode / decode + $val = decode($decode, $val) if ($decode); + $val = encode($encode, $val) if ($encode); + + if ($type =~ "[cd]") { + $data .= ($val ? '1' : '0'); + $counter++; + } else { + my $dataPart = pack ($unpack, $val); # use unpack code + Log3 $name, 5, "$name: PackObj packed $val with pack code $unpack to " . unpack ('H*', $dataPart); + $dataPart = substr ($dataPart . pack ('x' . $len * 2, undef), 0, $len * 2); + Log3 $name, 5, "$name: PackObj padded / cut object to " . unpack ('H*', $dataPart); + $counter += $len; + + $dataPart = Modbus_RevRegs($logHash, $dataPart, $len) if ($revRegs && length($dataPart > 3)); + $dataPart = Modbus_SwpRegs($logHash, $dataPart, $len) if ($swpRegs); + $data .= $dataPart; + } + + # gehe zum nächsten Wert + if ($type =~ "[cd]") { + $startAdr++; + } else { + $startAdr += $len; + } + if ($counter < $valuesLen) { + Log3 $name, 5, "$name: PackObj moves to next object, skip $len to $type$startAdr, counter=$counter"; + } else { + Log3 $name, 5, "$name: PackObj counter reached $counter"; + } + + } + if ($type =~ "[cd]") { + Log3 $name, 5, "$name: PackObj full bit string is $data"; + $data = pack ("b$valuesLen", $data); + Log3 $name, 5, "$name: PackObj packed / cut data string is " . unpack ('H*', $data); + # todo: is this format correct? + # not something like FF00? or only for special fc? + + } else { + Log3 $name, 5, "$name: PackObj full data string is " . unpack ('H*', $data); + # values len means registers so byte length is values len times 2 + $data = substr ($data . pack ('x' . $valuesLen * 2, undef), 0, $valuesLen * 2); + Log3 $name, 5, "$name: PackObj padded / cut data string to " . unpack ('H*', $data); + } + return $data; +} + + + + +####################################### +# Pack request pdu from fCode, adr, len +# and optionally the packed value +sub Modbus_PackRequest($$) +{ + my ($ioHash, $request) = @_; + my $name = $ioHash->{NAME}; + + my $fCode = $request->{FCODE}; + my $adr = $request->{ADR}; + my $len = $request->{LEN}; + my $values = $request->{VALUES}; + + Log3 $name, 5, "$name: PackRequest called from " . Modbus_Caller(); + my $data; + if ($fCode == 1 || $fCode == 2) { + # read coils / discrete inputs, pdu: fCode, startAdr, len (=number of coils) + $data = pack ('nn', $adr, $len); + } elsif ($fCode == 3 || $fCode == 4) { + # read holding/input registers, pdu: fCode, startAdr, len (=number of regs) + $data = pack ('nn', $adr, $len); + } elsif ($fCode == 5) { + # write single coil, pdu: fCode, startAdr, value (1-bit as FF00) + $data = pack ('n', $adr) . $values; + } elsif ($fCode == 6) { + # write single register, pdu: fCode, startAdr, value + $data = pack ('n', $adr) . $values; + # todo: shorten bit string and log message if more than one register is attempted here + + } elsif ($fCode == 15) { + # write multiple coils, pdu: fCode, startAdr, numOfCoils, byteCount, values + $data = pack ('nnC', $adr, $len, int($len/8)+1) . $values; + } elsif ($fCode == 16) { + # write multiple regs, pdu: fCode, startAdr, numOfRegs, byteCount, values + $data = pack ('nnC', $adr, $len, $len*2) . $values; + } else { + # function code not implemented yet + Log3 $name, 3, "$name: Send function code $fCode not yet implemented"; + return; + } + return pack ('C', $fCode) . $data; +} + + +############################################################### +# Pack response pdu from fCode, adr, len and the packed values +# or an error pdu if $response->{ERRCODE} contains something +sub Modbus_PackResponse($$) +{ + my ($ioHash, $response) = @_; + my $name = $ioHash->{NAME}; + + my $fCode = $response->{FCODE}; + my $adr = $response->{ADR}; + my $len = $response->{LEN}; + my $values = $response->{VALUES}; + + #Log3 $name, 5, "$name: PackResponse called from " . Modbus_Caller(); + my $data; + if ($response->{ERRCODE}) { # error PDU pdu: fCode+128, Errcode + return pack ('CC', $fCode + 128, $response->{ERRCODE}); + } elsif ($fCode == 1 || $fCode == 2) { # read coils / discrete inputs, pdu: fCode, len (=number of bytes), coils/inputs as bits + $data = pack ('C', int($len/8)+1) . $values; + } elsif ($fCode == 3 || $fCode == 4) { # read holding/input registers, pdu: fCode, len (=number of bytes), registers + $data = pack ('C', $len * 2) . $values; + } elsif ($fCode == 5) { # write single coil, pdu: fCode, startAdr, coil value (1-bit as FF00) + $data = pack ('n', $adr) . $values; + } elsif ($fCode == 6) { # write single register, pdu: fCode, startAdr, register value + $data = pack ('n', $adr) . $values; + } elsif ($fCode == 15) { # write multiple coils, pdu: fCode, startAdr, numOfCoils + $data = pack ('nn', $adr, $len); + } elsif ($fCode == 16) { # write multiple regs, pdu: fCode, startAdr, numOfRegs + $data = pack ('nn', $adr, $len); + } else { # function code not implemented yet + Log3 $name, 3, "$name: Send function code $fCode not yet implemented"; + return; + } + return pack ('C', $fCode) . $data; +} + + +####################################### +# Pack Modbus Frame +sub Modbus_PackFrame($$$$) +{ + my ($hash, $id, $pdu, $tid) = @_; + my $name = $hash->{NAME}; + my $proto = $hash->{PROTOCOL}; + + Log3 $name, 5, "$name: PackFrame called from " . Modbus_Caller() . " id $id" . + ($tid ? ", tid $tid" : "") . ", pdu " . unpack ('H*', $pdu); + + my $packedId = pack ('C', $id); + my $frame; + if ($proto eq "RTU") { # RTU frame format: ID, (fCode, data), CRC + my $crc = pack ('v', Modbus_CRC($packedId . $pdu)); + $frame = $packedId . $pdu . $crc; + } elsif ($proto eq "ASCII") { # ASCII frame format: ID, (fCode, data), LRC + my $lrc = uc(unpack ('H2', pack ('v', Modbus_LRC($packedId.$pdu)))); + $frame = ':' . uc(unpack ('H2', $packedId) . unpack ('H*', $pdu)) . $lrc . "\r\n"; + } elsif ($proto eq "TCP") { # TCP frame format: tid, 0, len, ID, (fCode, data) + my $dlen = bytes::length($pdu)+1; # length of pdu + Id + my $header = pack ('nnnC', ($tid, 0, $dlen, $id)); + $frame = $header.$pdu; + } else { + Log3 $name, 3, "$name: PackFrame got unknown protocol $proto"; + } + return $frame; +} + + + +##################################### +# send a frame string +# called from processRequestQueue, CreateResponse +# and RelayResponse +sub Modbus_Send($$$;$) +{ + my ($ioHash, $id, $frame, $logHash) = @_; + my $name = $ioHash->{NAME}; + Modbus_Profiler($ioHash, "Send"); + #Log3 $name, 3, "$name: insert Garbage for testing"; + #$ioHash->{READ}{BUFFER} = pack ("C",0); # test / debug / todo: remove + #Log3 $name, 5, "$name: Send called from " . Modbus_Caller(); + + if ($ioHash->{TCPServer}) { + Log3 $name, 3, "$name: Send called for TCP Server hash - this should not happen"; + return; + } + + if ($ioHash->{TCPChild}) { + # write to TCP connected modbus master / tcp client (we are modbus slave) + if (!$ioHash->{CD}) { + Log3 $name, 3, "$name: no connection to send to"; + return; + } + Log3 $name, 5, "$name: Send " . unpack ('H*', $frame); + for (;;) { + my $l = syswrite($ioHash->{CD}, $frame); + last if(!$l || $l == length($frame)); + $frame = substr($frame, $l); + } + $ioHash->{CD}->flush(); + } else { + if (!DevIo_IsOpen($ioHash)) { + Log3 $name, 3, "$name: no connection to send to"; + return; + } + # write to serial or TCP connected modbus slave / tcp server (we are modbus master) + DevIo_SimpleWrite($ioHash, $frame, 0); + } + + my $now = gettimeofday(); + $logHash->{REMEMBER}{lsend} = $now; # remember when last send to this device + $ioHash->{REMEMBER}{lsend} = $now; # remember when last send to this bus + $ioHash->{REMEMBER}{lid} = $id; # device id we talked to +} + + +######################################################################### +# set internal Timer to call GetUpdate if necessary +# either at next interval +# or if start is passed in start seconds (e.g. 2 seconds after Fhem init) +sub ModbusLD_StartUpdateTimer($;$) +{ + my ($hash, $start) = @_; + my $nextTrigger; + my $name = $hash->{NAME}; + my $now = gettimeofday(); + $start = 0 if (!$start); + + #Log3 $name, 5, "$name: StartUpdateTimer called from " . Modbus_Caller(); + + if ($hash->{INTERVAL} && $hash->{INTERVAL} > 0) { + if ($hash->{TimeAlign}) { + my $count = int(($now - $hash->{TimeAlign} + $start) / $hash->{INTERVAL}); + my $curCycle = $hash->{TimeAlign} + $count * $hash->{INTERVAL}; + $nextTrigger = $curCycle + $hash->{INTERVAL}; + } else { + $nextTrigger = $now + ($start ? $start : $hash->{INTERVAL}); + } + $hash->{TRIGGERTIME} = $nextTrigger; + $hash->{TRIGGERTIME_FMT} = FmtDateTime($nextTrigger); + RemoveInternalTimer("update:$name"); + InternalTimer($nextTrigger, "ModbusLD_GetUpdate", "update:$name", 0); + Log3 $name, 4, "$name: SetUpdateTimer updated timer - will call GetUpdate in " . + sprintf ("%.1f", $nextTrigger - $now) . " seconds at $hash->{TRIGGERTIME_FMT} - Interval $hash->{INTERVAL}"; + } else { + ModbusLD_StopUpdateTimer($hash); + } + return; +} + + +######################################################################### +# stop internal Timer to call GetUpdate (if it existed at all) +sub ModbusLD_StopUpdateTimer($) +{ + my ($hash) = @_; + my $name = $hash->{NAME}; + RemoveInternalTimer("update:$name"); + if ($hash->{TRIGGERTIME}) { + Log3 $name, 4, "$name: internal update interval timer stopped"; + delete $hash->{TRIGGERTIME}; + delete $hash->{TRIGGERTIME_FMT}; + } + return; +} + + ##################################### # called via internal timer from # logical device module with # update:name - name of logical device # +# connection doesn't need to be open - request can just be queued +# and then processqueue will call async open and remove queue entries +# if they get too old +# sub ModbusLD_GetUpdate($) { my $param = shift; my ($calltype,$name) = split(':',$param); - my $hash = $defs{$name}; # hash des logischen Devices, da GetUpdate aus dem logischen Modul per Timer gestartet wird + my $hash = $defs{$name}; # logisches Device, da GetUpdate aus dem logischen Modul per Timer gestartet wird my $modHash = $modules{$hash->{TYPE}}; my $parseInfo = $modHash->{parseInfo}; my $devInfo = $modHash->{deviceInfo}; my $now = gettimeofday(); - my $ioHash = ModbusLD_GetIOHash($hash); - Log3 $name, 5, "$name: GetUpdate called"; - - if ($calltype eq "update") { ## todo check if interval > min - ModbusLD_SetTimer($hash); + Log3 $name, 5, "$name: GetUpdate called from " . Modbus_Caller(); + if ($calltype eq "update") { + ModbusLD_StartUpdateTimer($hash); } - if (IsDisabled($name)) { - Log3 $name, 5, "$name: GetUpdate called but device is disabled"; - return; - } - - return if (!$ioHash); - if ($ioHash->{STATE} eq "disconnected") { - Log3 $name, 5, "$name: GetUpdate called, but device is disconnected"; + my $msg = ModbusLD_CheckDisable($hash); + if ($msg) { + Log3 $name, 5, "$name: GetUpdate called but $msg"; return; } + my $ioHash = ModbusLD_GetIOHash($hash); # only needed for profiling, availability id checked in CheckDisable Modbus_Profiler($ioHash, "Fhem"); - my @ObjList; my %readList; @@ -2518,18 +3644,19 @@ sub ModbusLD_GetUpdate($) { foreach my $objCombi (sort @ObjList) { #my $type = substr($objCombi, 0, 1); #my $adr = substr($objCombi, 1); - my $reading = ModbusLD_ObjInfo($hash, $objCombi, "reading"); + my $reading = Modbus_ObjInfo($hash, $objCombi, "reading"); my $objHashRef = $parseInfo->{$objCombi}; #my $devTypeRef = $devInfo->{$type}; - my $poll = ModbusLD_ObjInfo($hash, $objCombi, "poll", "defPoll", 0); + my $poll = Modbus_ObjInfo($hash, $objCombi, "poll", "defPoll", 0); my $lastRead = ($hash->{lastRead}{$objCombi} ? $hash->{lastRead}{$objCombi} : 0); Log3 $name, 5, "$name: GetUpdate check $objCombi => $reading, poll = $poll, last = $lastRead"; if (($poll && $poll ne "once") || ($poll eq "once" && !$lastRead)) { - my $delay = ModbusLD_ObjInfo($hash, $objCombi, "polldelay", "", "0.5"); + my $delay = Modbus_ObjInfo($hash, $objCombi, "polldelay", "", "0.5"); if ($delay =~ "^x([0-9]+)") { - $delay = $1 * $hash->{INTERVAL}; # Delay als Multiplikator des Intervalls falls es mit x beginnt. + $delay = $1 * ($hash->{INTERVAL} ? $hash->{INTERVAL} : 1); + # Delay als Multiplikator des Intervalls falls es mit x beginnt. } if ($now >= $lastRead + $delay) { @@ -2552,39 +3679,39 @@ sub ModbusLD_GetUpdate($) { foreach $nextObj (sort Modbus_compObjKeys keys %readList) { $nextType = substr($nextObj, 0, 1); $nextAdr = substr($nextObj, 1); - $nextReading = ModbusLD_ObjInfo($hash, $nextObj, "reading"); - $nextLen = ModbusLD_ObjInfo($hash, $nextObj, "len", "defLen", 1); + $nextReading = Modbus_ObjInfo($hash, $nextObj, "reading"); + $nextLen = Modbus_ObjInfo($hash, $nextObj, "len", "defLen", 1); $readList{$nextObj} = $nextLen; if ($obj && $maxLen){ $nextSpan = ($nextAdr + $nextLen) - $adr; # Combined length with next object if ($nextType eq $type && $nextSpan <= $maxLen && $nextSpan > $span) { - Log3 $name, 5, "$name: Combine $reading ($obj) with $nextReading ($nextObj), ". + Log3 $name, 5, "$name: GetUpdate combines request for $reading ($obj) with $nextReading ($nextObj), ". "span=$nextSpan, max=$maxLen, drop read for $nextObj"; delete $readList{$nextObj}; # no individual read for this object, combine with last $span = $nextSpan; $readList{$obj} = $nextSpan; # increase the length to include following object next; # don't change current object variables } else { - Log3 $name, 5, "$name: No Combine $reading / $obj with $nextReading / $nextObj, ". + Log3 $name, 5, "$name: GetUpdate cant combine request for $reading / $obj with $nextReading / $nextObj, ". "span $nextSpan > max $maxLen"; $nextSpan = 0; } } ($obj, $type, $adr, $reading, $len, $span) = ($nextObj, $nextType, $nextAdr, $nextReading, $nextLen, $nextSpan); - $maxLen = ModbusLD_DevInfo($hash, $type, "combine", 1); + $maxLen = Modbus_DevInfo($hash, $type, "combine", 1); # Log3 $name, 5, "$name: GetUpdate: combine for $type is $maxLen"; } if (AttrVal($name, "sortUpdate", 0)) { - Log3 $name, 5, "$name: sort objList before sending requests"; + Log3 $name, 5, "$name: GetUpdate is sorting objList before sending requests"; foreach my $objCombi (sort Modbus_compObjKeys keys %readList) { my $span = $readList{$objCombi}; - ModbusLD_Send($hash, $objCombi, "read", 0, 0, $span); + ModbusLD_DoRequest($hash, $objCombi, "read", 0, 0, $span); } } else { - Log3 $name, 5, "$name: don't sort objList before sending requests"; + Log3 $name, 5, "$name: GetUpdate doesn't sort objList before sending requests"; while (my ($objCombi, $span) = each %readList) { - ModbusLD_Send($hash, $objCombi, "read", 0, 0, $span); + ModbusLD_DoRequest($hash, $objCombi, "read", 0, 0, $span); } } Modbus_Profiler($ioHash, "Idle"); @@ -2592,37 +3719,739 @@ sub ModbusLD_GetUpdate($) { } - -###################################### -# called from logical device fuctions -# with log dev hash to get the -# physical io device hash - -sub ModbusLD_GetIOHash($){ - my $hash = shift; - my $name = $hash->{NAME}; # name of logical device - my $ioHash; +###################################################### +# log current frame in buffer +sub Modbus_LogFrame($$$;$$) +{ + my ($hash, $msg, $logLvl, $request, $response) = @_; + my $name = $hash->{NAME}; + $request = $hash->{REQUEST} if (!$request); + $response = $hash->{RESPONSE} if (!$response); - #Log3 $name, 5, "$name: GetIOHash, TYPE = $hash->{TYPE}" . ($hash->{DEST} ? ", DEST = $hash->{DEST}" : ""); - if ($hash->{TYPE} eq "Modbus") { - # physical Device - return $hash; + Log3 $name, $logLvl, "$name: $msg" . + ($request ? ", request: id $request->{MODBUSID}, fCode $request->{FCODE}" . + (defined($request->{TID}) ? ", tid $request->{TID}" : "") . + ($request->{TYPE} ? ", type $request->{TYPE}" : "") . + (defined($request->{ADR}) ? ", adr $request->{ADR}" : "") . + ($request->{LEN} ? ", len $request->{LEN}" : "") . + ($request->{VALUES} ? ", value " . unpack('H*', $request->{VALUES}) : "") . + ($request->{DEVHASH} ? " for device $request->{DEVHASH}{NAME}" : "") . + ($request->{READING} ? " reading $request->{READING}" : "") + : "") . + ($hash->{READ}{BUFFER} ? ", Current read buffer: " . unpack('H*', $hash->{READ}{BUFFER}) : ", read buffer empty") . + ($hash->{FRAME}{MODBUSID} ? ", Id $hash->{FRAME}{MODBUSID}" : "") . + ($hash->{FRAME}{FCODE} ? ", fCode $hash->{FRAME}{FCODE}" : "") . + (defined($hash->{FRAME}{TID}) ? ", tid $hash->{FRAME}{TID}" : "") . + ($response ? ", response: id $response->{MODBUSID}, fCode $response->{FCODE}" . + (defined($response->{TID}) ? ", tid $response->{TID}" : "") . + ($response->{TYPE} ? ", type $response->{TYPE}" : "") . + (defined($response->{ADR}) ? ", adr $response->{ADR}" : "") . + ($response->{LEN} ? ", len $response->{LEN}" : "") . + ($response->{VALUES} ? ", value " . unpack('H*', $response->{VALUES}) : "") + : "") . + ($hash->{FRAME}{ERROR} ? ", error: $hash->{FRAME}{ERROR}" : ""); + return; +} + + +###################################################### +# drop current frame from buffer or clear full buffer +# caled from Timeout-, Done and Error functions +sub Modbus_DropFrame($) +{ + my ($hash) = @_; + my $name = $hash->{NAME}; + my $drop = $hash->{READ}{BUFFER}; + my $rest = ""; + + if ($hash->{MODE} ne 'master' && $hash->{FRAME}{PDULEXP} && $hash->{PROTOCOL}) { + my $frameLen = $hash->{FRAME}{PDULEXP} + $Modbus_PDUOverhead{$hash->{PROTOCOL}}; + $drop = substr($hash->{READ}{BUFFER}, 0, $frameLen); + $rest = substr($hash->{READ}{BUFFER}, $frameLen); + } + Log3 $name, 5, "$name: DropFrame - drop " . unpack ('H*', $drop) . + ($rest ? " rest " . unpack ('H*', $rest) : ""); + $hash->{READ}{BUFFER} = $rest; + delete $hash->{FRAME}; + return; +} + + +################################################## +# add a message to the $frame->{ERROR} String +sub Modbus_AddFrameError($$) +{ + my ($frame, $msg) = @_; + $frame->{ERROR} .= ($frame->{ERROR} ? ', ' : '') . $msg; +} + + +################################################################## +# get end of pdu / start of lrc / crc if applicable +# check crc / lrc and set $hash->{FRAME}{CHECKSUMERR} if necessary +# leave length checking, reaction / logging / dropping +# to read function +sub Modbus_CheckChecksum($) +{ + my ($hash) = @_; + my $name = $hash->{NAME}; + my $proto = $hash->{PROTOCOL}; + my $frame = $hash->{FRAME}; + + use bytes; + my $frameLen = $frame->{PDULEXP} + $Modbus_PDUOverhead{$hash->{PROTOCOL}}; + my $readLen = length($hash->{READ}{BUFFER}); + delete $frame->{CHECKSUMERROR}; + + if ($proto eq "RTU") { + my $crcInputLen = ($readLen < $frameLen ? $readLen - 2 : $frameLen - 2); + $frame->{CHECKSUMSENT} = unpack ('v', substr($hash->{READ}{BUFFER}, $crcInputLen, 2)); + $frame->{CHECKSUMCALC} = Modbus_CRC(substr($hash->{READ}{BUFFER}, 0, $crcInputLen)); + } elsif ($proto eq "ASCII") { + my $lrcInputLen = ($readLen < $frameLen ? $readLen - 5 : $frameLen - 5); + $frame->{CHECKSUMSENT} = hex(substr($hash->{READ}{BUFFER}, $lrcInputLen + 1, 2)); + $frame->{CHECKSUMCALC} = Modbus_LRC(pack ('H*', substr($hash->{READ}{BUFFER}, 1, $lrcInputLen))); + } elsif ($proto eq "TCP") { + # nothing to be done. + return 1; } else { - # logical Device - if ($hash->{DEST}) { - return $hash; # Modbus TCP/RTU/ASCII über TCP, physical hash = logical hash - } else { - return $hash->{IODev} if ($hash->{IODev}); # logical device needs pointer to physical device (IODev) - if (ModbusLD_SetIODev($hash)) { - return $hash->{IODev}; + Log3 $name, 3, "$name: CheckChecksum (called from " . Modbus_Caller() . ") got unknown protocol $proto"; + return 0; + } + + if ($frame->{CHECKSUMCALC} != $frame->{CHECKSUMSENT}) { + $frame->{CHECKSUMERROR} = 1; + Modbus_AddFrameError($frame, "Invalid checksum " . unpack ('H4', pack ('v', $frame->{CHECKSUMSENT})) . + " received. Calculated " . unpack ('H4', pack ('v', $frame->{CHECKSUMCALC}))); + return 0; + } else { + Log3 $name, 5, "$name: CheckChecksum (called from " . Modbus_Caller() . "): " . unpack ('H4', pack ('v', $frame->{CHECKSUMSENT})) . " is valid"; + } + return 1; +} + + +####################################### +sub Modbus_CountTimeouts($) +{ + my ($hash) = @_; + my $name = $hash->{NAME}; + + if ($hash->{TCPConn}) { # modbus TCP/RTU/ASCII over TCP + if ($hash->{TCPServer} || $hash->{TCPChild}) { + Log3 $name, 3, "$name: CountTimeouts called for TCP Server connection - this should not happen"; + return; + } + if ($hash->{TIMEOUTS}) { + $hash->{TIMEOUTS}++; + my $max = AttrVal($name, "maxTimeoutsToReconnect", 0); + if ($max && $hash->{TIMEOUTS} >= $max) { + Log3 $name, 3, "$name: CountTimeouts counted $hash->{TIMEOUTS} successive timeouts, setting state to disconnected"; + DevIo_Disconnected($hash); # close, set state and put on readyfnlist for reopening } - Log3 $name, 3, "$name: no IODev attribute or matching physical Modbus-device found for $hash->{NAME}"; + } else { + $hash->{TIMEOUTS} = 1; } } return; } +############################################### +# Called via InternalTimer with "stimeout:$name" +# timer is set in ... +# if this is called, we are TCP Slave +sub Modbus_ServerTimeout($) +{ + my ($param) = @_; + my ($error,$name) = split(':',$param); + my $hash = $defs{$name}; + if ($hash) { + if ($hash->{CHILDOF}) { + my $pHash = $hash->{CHILDOF}; + my $pName = $pHash->{NAME}; + if ($pName) { + Log3 $pName, 4, "$pName: closing connection after inactivity"; + } + } + Modbus_Close($hash); + } + return; +}; + + +############################################### +# Called via InternalTimer with "timeout:$name" +# timer is set in HandleRequestQueue only +# if this is called, we are Master and did send a request +# or we were used as relay forward device +sub Modbus_ResponseTimeout($) +{ + my ($param) = @_; + my ($error,$name) = split(':',$param); + my $hash = $defs{$name}; + my $logLvl = AttrVal($name, "timeoutLogLevel", 3); + $hash->{EXPECT} = 'idle'; + Log3 $name, 3, "$name: ResponseTimeout called, devhash=$hash->{REQUEST}{DEVHASH}, name of devhash=$hash->{REQUEST}{DEVHASH}{NAME}"; + #Modbus_StopQueueTimer($hash); # don't touch timer here - it is set anyway before fhem does anything else + Modbus_LogFrame($hash, "Timeout waiting for a modbus response", $logLvl); + Modbus_Statistics($hash, "Timeouts", 1); + Modbus_CountTimeouts ($hash); + if ($hash->{REQUEST}{DEVHASH}{MODE} eq 'relay') { # create an error response + # when relaying $hash->{REQUEST} is a copy of the original request + my $slHash = $hash->{REQUEST}{DEVHASH}; # hash of logical relay device that got the first request + my $ioHash = ModbusLD_GetIOHash($slHash); # the ioHash that received the original request + if (!$ioHash) { + Log3 $name, 4, "$name: sending timout response back failed because relay slave side io device disappeared"; + } else { + $ioHash->{REQUEST}{ERRCODE} = 11; # gw target failed to respond + Modbus_CreateResponse($ioHash); # create an error response, don't pack values since ERRCODE is set + } + } + Modbus_Profiler($hash, "Idle"); + Modbus_DropFrame($hash); + delete $hash->{nextTimeout}; + + my $retries = AttrVal($name, "retriesAfterTimeout", 0); + $hash->{RETRY} = ($hash->{RETRY} ? $hash->{RETRY} : 0); # deleted in doRequest and responseDone + if ($hash->{RETRY} < $retries) { + $hash->{RETRY}++; + Log3 $name, 4, "$name: retry last request, retry counter $hash->{RETRY}"; + Modbus_QueueRequest($hash, $hash->{REQUEST}, 1); # force + } else { + delete $hash->{REQUEST}; + delete $hash->{RETRY}; + } + + Modbus_StartQueueTimer($hash, 0); # call processRequestQueue at next possibility if appropriate + return; +}; + + + +##################################### +# Modbus_ResponseDone +# called with physical device hash at the end of HandleResponse which itself is calld from read / readanswer +sub Modbus_ResponseDone($$) +{ + my ($hash, $logLvl) = @_; + my $name = $hash->{NAME}; + my $msg = ($hash->{FRAME}{ERROR} ? "ResponseDone with error: $hash->{FRAME}{ERROR}" : "ResponseDone"); + Modbus_LogFrame($hash, $msg, $logLvl) if ($logLvl); + Modbus_Statistics($hash, "Timeouts", 0); # damit bei Bedarf das Reading gesetzt wird + Modbus_Profiler($hash, "Idle"); # todo: fix + $hash->{EXPECT} = ($hash->{MODE} eq 'master' ? 'idle' : 'request'); + Modbus_DropFrame($hash); + delete $hash->{nextTimeout}; + delete $hash->{TIMEOUTS}; + delete $hash->{RETRY}; + RemoveInternalTimer ("timeout:$name"); + return; +} +# processRequestQueue or startQueueTimer is not called in ResponseDone because +# when called from read, startQueueTimer is called in read after HandleResponse +# when called from readAnswer, readAnswer returns to get/set who call stertQueueTimer at the end + + + +##################################### +# Modbus_RequestDone +# called with physical device hash from Read +# when we are succussfully done with a request and ready for the response +sub Modbus_RequestDone($$) +{ + my ($hash, $logLvl) = @_; + my $name = $hash->{NAME}; + my $msg = ($hash->{FRAME}{ERROR} ? "RequestDone with error: $hash->{FRAME}{ERROR}" : "RequestDone"); + Modbus_LogFrame($hash, $msg, $logLvl) if ($logLvl); + Modbus_Profiler($hash, "Idle"); # todo: fix + + if (($hash->{MODE} eq 'slave' || $hash->{MODE} eq 'relay') && $hash->{REQUEST}{DEVHASH}) { + $hash->{EXPECT} = 'request'; # we did answer or forward this request (relaying made a copy) + #delete $hash->{REQUEST}; # dont't delete because sending an error fro the relay might need it + } else { + $hash->{EXPECT} = 'response'; # not our request, parse response that follows, keep $hash->{REQUEST} for parsing the response (e.g. passive) + } + Modbus_DropFrame($hash); + delete $hash->{RESPONSE}; + return; +} + + + +############################################### +# Called from ReadAnswer +# we are master and did wait for a response +sub Modbus_ReadAnswerTimeout($$) +{ + my ($hash, $msg) = @_; + my $name = $hash->{NAME}; + + my $logLvl = AttrVal($name, "timeoutLogLevel", 3); + $hash->{EXPECT} = 'idle'; + Modbus_LogFrame($hash, $msg, $logLvl); + Modbus_Statistics($hash, "Timeouts", 1); + Modbus_CountTimeouts ($hash); + Modbus_Profiler($hash, "Idle"); + Modbus_DropFrame($hash); + delete $hash->{nextTimeout}; + Modbus_StartQueueTimer($hash, 0); # call processRequestQueue at next possibility if appropriate + return $msg; +}; + + +############################################### +# Called from ReadAnswer +# we are master and did wait for a response +sub Modbus_ReadAnswerError($$) +{ + my ($hash, $msg) = @_; + my $name = $hash->{NAME}; + + my $logLvl = AttrVal($name, "timeoutLogLevel", 3); + $hash->{EXPECT} = 'idle'; + Modbus_LogFrame($hash, $msg, $logLvl); + Modbus_Profiler($hash, "Idle"); + Modbus_DropFrame($hash); + delete $hash->{REQUEST}; + delete $hash->{nextTimeout}; + Modbus_StartQueueTimer($hash, 0); # call processRequestQueue at next possibility if appropriate + return $msg; +}; + + +############################################ +# Check if disabled or IO device is disabled +sub ModbusLD_CheckDisable($) +{ + my ($hash) = @_; + my $name = $hash->{NAME}; + my $msg; + #Log3 $name, 5, "$name: CheckDisable called from " . Modbus_Caller(); + + if ($hash->{TYPE} eq 'Modbus' || $hash->{TCPConn}) { # physical hash + if (IsDisabled($name)) { + $msg = "device is disabled"; + } + } else { # this is a logical device hash + my $ioHash = ModbusLD_GetIOHash($hash); # get physical io device hash + if (IsDisabled($name)) { + $msg = "device is disabled"; + } elsif (!$ioHash) { + $msg = "no IO Device to communicate through"; + } elsif (IsDisabled($ioHash->{NAME})) { + $msg = "IO device is disabled"; + } + } + Log3 $name, 5, "$name: CheckDisable returns $msg" if ($msg); + return $msg; +} + + +############################################################### +# Check if connection through IO Dev is not disabled +# and call open (force) if necessary for prioritized get / set +# and potentially take over last read with readAnswer +# +# if non prioritized get / set (parameter async = 1) +# we leave the connection management to ready and processRequestQueue +# +sub ModbusLD_GetSetChecks($$) +{ + my ($hash, $async) = @_; + my $name = $hash->{NAME}; + my $force = !$async; + my $msg = ModbusLD_CheckDisable($hash); + if (!$msg) { + if ($hash->{MODE} && $hash->{MODE} ne 'master') { + $msg = "only possible as Modbus master"; + } elsif ($force) { + # only check connection if not async + my $ioHash = ModbusLD_GetIOHash($hash); # physical hash to check busy / take over with readAnswer + if (!$ioHash) { + $msg = "no IO device"; + } elsif (!DevIo_IsOpen($ioHash)) { + Modbus_Open($ioHash, 0, $force); # force synchronous open unless non prioritized get / set + if (!DevIo_IsOpen($ioHash)) { + $msg = "device is disconnected"; + } elsif ($ioHash->{EXPECT} eq 'response') { # Answer for last request has not yet arrived + Log3 $name, 4, "$name: GetSetChecks calls ReadAnswer to take over async read (still waiting for response"; + # no $msg because we want to continue afterwards + Modbus_ReadAnswer($ioHash); # finish last read and wait for result + } + } + } + } + Log3 $name, 5, "$name: GetSetChecks returns $msg" if ($msg); + return $msg; +} + + +################################################################ +# reconstruct the $hash->{IODev} pointer to the physical device +# if it is not set by checking the IODev attr or +# searching for a suitable device +# +# called from GetIOHash with the logical hash +################################################################ +sub ModbusLD_SetIODev($;$) +{ + my ($hash, $setIOName) = @_; + return $hash if ($hash->{TCPConn}); + my $name = $hash->{NAME}; + my $id = $hash->{MODBUSID}; + my $ioHash; + + Log3 $name, 5, "$name: SetIODev called from " . Modbus_Caller(); + my $ioName = ($setIOName ? $setIOName : AttrVal($name, "IODev", "")); + + if ($ioName) { # if we have a name (passed or from attribute), check its usability + if (!$defs{$ioName}) { + Log3 $name, 3, "$name: SetIODev from $name to $ioName but $ioName does not exist (yet?)"; + } elsif (ModbusLD_CheckIOCompat($hash, $defs{$ioName},3)) { + $ioHash = $defs{$ioName}; # ioName can be used as io device, set hash + } + } + if (!$ioHash && !$ioName) { # if no attr and no name passed search for usable io device + for my $p (sort { $defs{$b}{NR} <=> $defs{$a}{NR} } keys %defs) { + if (ModbusLD_CheckIOCompat($hash, $defs{$p},5)) { + $ioHash = $defs{$p}; + last; + } + } + } + ModbusLD_UnregAtIODev($hash); + if (!$ioHash) { # still nothing found -> give up for now + Log3 $name, 3, "$name: SetIODev found no usable physical modbus device"; + $hash->{STATE} = "disconnected"; # set state like DevIO would do it after disconnected + readingsSingleUpdate($hash, "state", "disconnected", 1); + delete $hash->{IODev}; + return undef; + } + ModbusLD_RegisterAtIODev($hash, $ioHash); + + # set initial state like DevIO would do it after open + $hash->{STATE} = "opened"; + readingsSingleUpdate($hash, "state", "opened", 1); + return $ioHash; +} + + +##################################################################### +# called from logical device fuctions with log dev hash +# to get the physical io device hash which should be +# stored in $hash->{IODev} (fhem.pl sets this when IODev attr is set) +# reconstruct this pointer by calling SetIODev if necessary +# +# called from many LD functions like get, set, getUpdate, send, ... +##################################################################### +sub ModbusLD_GetIOHash($){ + my $hash = shift; + my $name = $hash->{NAME}; # name of logical device + #Log3 $name, 5, "$name: GetIOHash called from " . Modbus_Caller(); + + 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! + + if ($hash->{IODev} && ModbusLD_CheckIOCompat($hash, $hash->{IODev}, 4)) { + return $hash->{IODev}; + } + + Log3 $name, 4, "$name: GetIOHash (called from " . Modbus_Caller() . ") didn't find valid IODev hash key, calling SetIODev now"; + return $hash->{IODev} if (ModbusLD_SetIODev($hash)); # reconstruct pointer to physical device + Log3 $name, 4, "$name: GetIOHash didn't find IODev attribute or matching physical serial Modbus device"; +} + + +##################################################################### +# Check if $ioHash can be used as IODev for $hash +# return 1 if ok, log if not +##################################################################### +sub ModbusLD_CheckIOCompat($$;$){ + my ($hash, $ioHash, $logLvl) = @_; + my $name = $hash->{NAME}; # name of logical device + my $ioName = $ioHash->{NAME}; # name of physical device + my $id = $hash->{MODBUSID}; # Modbus id of logical device + + return 1 if ($hash->{TCPConn}); # for TCP/IP connected devices ioHash = hash so everything is fine + my $msg; + if (!$ioHash) { + #$msg = "no ioHash passed"; + return; + } elsif (!$id){ + #$msg = "no Modbus id set for $name"; + return; + } elsif ($ioHash->{TYPE} ne "Modbus") { # TCP was checked before so it has to be "Modbus" + #$msg = "$ioName is not a physical Modbus Device"; + return; + } elsif (!$hash->{PROTOCOL}) { + $msg = "$name doesn't have a protocol set"; + } elsif (!$hash->{MODE}) { + $msg = "$name doesn't have a mode set"; + } elsif ($ioHash->{PROTOCOL} && $ioHash->{PROTOCOL} ne $hash->{PROTOCOL}) { + my $lName = Modbus_DevLockingKey($ioHash, 'PROTOCOL'); + $lName = 'unknown (this should not happen)' if (!$lName); + $msg = "$ioName is locked to protocol $ioHash->{PROTOCOL} by $lName"; + } elsif ($ioHash->{MODE} && $ioHash->{MODE} ne $hash->{MODE}) { + my $lName = Modbus_DevLockingKey($ioHash, 'MODE'); + $lName = 'unknown (this should not happen)' if (!$lName); + $msg = "$ioName is locked to mode $ioHash->{MODE} by $lName"; + } elsif ($ioHash->{MODE} && $ioHash->{MODE} ne 'master') { # only for a master multiple devices can use the same id + for my $ld (keys %{$ioHash->{defptr}}) { # for each registered logical device + if ($ld ne $name && $defs{$ld} && $defs{$ld}{MODBUSID} == $id) { + $msg = "$ioName has already registered id $id for $ld"; + } + } + } + if ($msg) { + Log3 $name, ($logLvl ? $logLvl : 5), "$name: CheckIOCompat (called from " . Modbus_Caller() . ") for $name and $ioName: $msg"; + return; + } + return 1; +} + + +################################################################ +# register / lock protocol and mode at io dev +################################################################ +sub ModbusLD_RegisterAtIODev($$) +{ + my ($hash, $ioHash) = @_; + return if ($hash->{TCPConn}); + my $name = $hash->{NAME}; + my $id = $hash->{MODBUSID}; + my $ioName = $ioHash->{NAME}; + + Log3 $name, 3, "$name: RegisterAtIODev called from " . Modbus_Caller() . " registers $name at $ioName with id $id" . + ($hash->{MODE} ? ", MODE $hash->{MODE}" : "") . + ($hash->{PROTOCOL} ? ", PROTOCOL $hash->{PROTOCOL}" : ""); + + $hash->{IODev} = $ioHash; # point internal IODev to io device hash + + # todo: + # change way of registration. not with id but with name. + # only getLogHash needs change then (search all registered devices) + + $ioHash->{defptr}{$name} = $id; # register logical device for given id at io + $ioHash->{PROTOCOL} = $hash->{PROTOCOL}; # lock protocol and mode + $ioHash->{MODE} = $hash->{MODE}; +} + + + +################################################################ +# unregister / unlock protocol and mode at io dev +# to be called when MODBUSID or IODEv changes +# or when device is deleted +# see attr, notify or directly from undef +################################################################ +sub ModbusLD_UnregAtIODev($) +{ + my ($hash) = @_; + return if ($hash->{TCPConn}); + my $name = $hash->{NAME}; + my $id = $hash->{MODBUSID}; + Log3 $name, 5, "$name: UnregAtIODev called from " . Modbus_Caller(); + + for my $d (values %defs) { # go through all physical Modbus devices + if ($d->{TYPE} eq 'Modbus') { + my $protocolCount = 0; + my $modeCount = 0; + for my $ld (keys %{$d->{defptr}}) { # and their registrations + #for my $id (keys %{$d->{defptr}}) { # and their registrations + my $ldev = $defs{$ld}; + if ($ldev && $ld eq $name) { + Log3 $name, 5, "$name: UnregAtIODev is removing $name from registrations at $d->{NAME}"; + delete $d->{defptr}{$name}; # delete id as key pointing to $hash if found + } else { + if ($ldev && $ldev->{PROTOCOL} eq $d->{PROTOCOL}) { + $protocolCount++; + } else { + Log3 $name, 3, "$name: UnregAtIODev called from " . Modbus_Caller() . " found device $ld" . + " with protocol $ldev->{PROTOCOL} registered at $d->{NAME} with protocol $d->{PROTOCOL}." . + " This should not happen"; + } + if ($ldev->{MODE} eq $d->{MODE}) { + $modeCount++; + } else { + Log3 $name, 3, "$name: UnregAtIODev called from " . Modbus_Caller() . " found device $ld" . + " with mode $ldev->{MODE} registered at $d->{NAME} with mode $d->{MODE}." . + " This should not happen"; + } + } + } + if (!$protocolCount && !$modeCount) { + Log3 $name, 5, "$name: UnregAtIODev is removing locks at $d->{NAME}"; + delete $d->{PROTOCOL}; + delete $d->{MODE}; + } + } + } +} + + +##################################################################### +# called from HandleRequest / HandleResponse +# with Modbus ID to get logical device hash responsible for this Id +# +# The Id passed here (from a received Modbus frame) is looked up +# in the table of registered logical devices. +# for requests this is the way to find the right logical device hash +# +# for responses it should match the id of the request sent/seen before +# +# The logical device hash pointed to should have this id set as well +# and if it is TCP connected, the logical has is also the physical +# + +# todo: pass mode required (master or slave/relay?) ?? + +##################################################################### +sub Modbus_GetLogHash($$){ + my ($ioHash, $Id) = @_; + my $name = $ioHash->{NAME}; # name of physical device + my $logHash; + my $logName; + + if ($ioHash->{TCPConn}) { + $logHash = $ioHash; # Modbus TCP/RTU/ASCII über TCP, physical hash = logical hash + } else { + for my $ld (keys %{$ioHash->{defptr}}) { # for each registered logical device + if ($ioHash->{defptr}{$ld} == $Id) { + $logHash = $defs{$ld}; + } + } + if (!$logHash) { + for my $d (values %defs) { # go through all physical Modbus devices and look for a suitable one + if ($d->{TYPE} ne 'Modbus' && $d->{MODULEVERSION} && $d->{MODULEVERSION} =~ /^Modbus / + && $d->{MODBUSID} eq $Id && $d->{PROTOCOL} eq $ioHash->{PROTOCOL} && $d->{MODE} eq $ioHash->{MODE}) { + $logHash = $d; + Log3 $name, 3, "$name: GetLogHash called from " . Modbus_Caller() . + " found logical device by searching! This should not happen"; + } + } + } + } + + if ($logHash) { + $logName = $logHash->{NAME}; + if ($logHash->{MODBUSID} != $Id) { + Log3 $name, 3, "$name: GetLogHash called from " . Modbus_Caller() . " detected wrong Modbus Id"; + $logHash = undef; + } else { + Log3 $name, 5, "$name: GetLogHash returns hash for device $logName" if (!$ioHash->{TCPConn}); + } + } else { + Log3 $name, 5, "$name: GetLogHash didnt't find a logical device for Modbus id $Id"; + } + return $logHash +} + + + +####################################################################################### +# who locked key at iodev ? +sub Modbus_DevLockingKey($$) +{ + my ($ioHash, $key) = @_; + my $ioName = $ioHash->{NAME}; + + my $found; + foreach my $ld (keys %{$ioHash->{defptr}}) { + if ($defs{$ld} && $defs{$ld}{$key} eq $ioHash->{$key}) { + $found = 1; + Log3 $ioName, 5, "$ioName: DevLockingKey found $ld to lock key $key at $ioName as $defs{$ld}{$key}"; + return $ld; + } + } + return undef; +} + + +######################################## +# not used currently +sub Modbus_compObjAttrs ($$) { + my ($a, $b) = @_; + my $aType = substr($a, 4, 1); + my $aStart = substr($a, 5); + my $bType = substr($b, 4, 1); + my $bStart = substr($b, 5); + my $result = ($aType cmp $bType); + if ($result) { + return $result; + } + $result = $aStart <=> $bStart; + return $result; +} + + +######################################## +# used for sorting and combine checking +sub Modbus_compObjKeys ($$) { + my ($a, $b) = @_; + my $aType = substr($a, 0, 1); + my $aStart = substr($a, 1); + my $bType = substr($b, 0, 1); + my $bStart = substr($b, 1); + my $result = ($aType cmp $bType); + if ($result) { + return $result; + } + $result = $aStart <=> $bStart; + return $result; +} + + + +#################################################### +# format time as string with msecs as fhem.pl does +sub Modbus_FmtTime($) +{ + my ($time) = @_; + my $seconds = int ($time); + my $mseconds = $time - $seconds; + my @t = localtime($seconds); + my $tim = sprintf("%02d:%02d:%02d", $t[2],$t[1],$t[0]); + $tim .= sprintf(".%03d", $mseconds*1000); + return $tim; +} + + + +##################################### +sub Modbus_CRC($) { + use bytes; + my $frame = shift; + my $crc = 0xFFFF; + my ($chr, $lsb); + for my $i (0..bytes::length($frame)-1) { + $chr = ord(bytes::substr($frame, $i, 1)); + $crc ^= $chr; + for (1..8) { + $lsb = $crc & 1; + $crc >>= 1; + $crc ^= 0xA001 if $lsb; + } + } + no bytes; + return $crc; +} + + +##################################### +sub Modbus_LRC($) { + use bytes; + my $frame = shift; + my $lrc = 0; + my $chr; + for my $i (0..bytes::length($frame)-1) { + $chr = ord(bytes::substr($frame, $i, 1)); + $lrc = ($lrc + $chr) & 0xff; + } + return (0xff - $lrc) +1; +} + + ##################################### # called from send and parse # reverse order of word registers @@ -2630,7 +4459,7 @@ sub Modbus_RevRegs($$$) { my ($hash, $buffer, $len) = @_; # hash only needed for logging my $name = $hash->{NAME}; # name of device for logging - Log3 $name, 5, "$name: RevRegs: reversing order of up to $len registers"; + Log3 $name, 5, "$name: RevRegs is reversing order of up to $len registers"; my $work = substr($buffer, 0, $len * 2); # the first 2*len bytes of buffer my $rest = substr($buffer, $len * 2); # everything after len @@ -2639,9 +4468,9 @@ sub Modbus_RevRegs($$$) { $new = substr($work, 0, 2) . $new; # prepend first two bytes of work to new $work = substr($work, 2); # remove first word from work } - Log3 $name, 5, "$name: RevRegs: string before is " . unpack ("H*", $buffer); + Log3 $name, 5, "$name: RevRegs string before is " . unpack ("H*", $buffer); $buffer = $new . $rest; - Log3 $name, 5, "$name: RevRegs: string after is " . unpack ("H*", $buffer); + Log3 $name, 5, "$name: RevRegs string after is " . unpack ("H*", $buffer); return $buffer; } @@ -2653,119 +4482,365 @@ sub Modbus_SwpRegs($$$) { my ($hash, $buffer, $len) = @_; # hash only needed for logging my $name = $hash->{NAME}; # name of device for logging - Log3 $name, 5, "$name: SwpRegs: reversing byte order of up to $len registers"; + Log3 $name, 5, "$name: SwpRegs is reversing byte order of up to $len registers"; my $rest = substr($buffer, $len * 2); # everything after len my $nval = ""; for (my $i = 0; $i < $len; $i++) { $nval = $nval . substr($buffer,$i*2 + 1,1) . substr($buffer,$i*2,1); }; - Log3 $name, 5, "$name: SwpRegs: string before is " . unpack ("H*", $buffer); + Log3 $name, 5, "$name: SwpRegs string before is " . unpack ("H*", $buffer); $buffer = $nval . $rest; - Log3 $name, 5, "$name: SwpRegs: string after is " . unpack ("H*", $buffer); + Log3 $name, 5, "$name: SwpRegs string after is " . unpack ("H*", $buffer); return $buffer; } +################################################ +# Get obj- Attribute with potential +# leading zeros +sub Modbus_ObjAttr($$$) { + my ($hash, $key, $oName) = @_; + my $name = $hash->{NAME}; + my $aName = "obj-".$key."-".$oName; + return $attr{$name}{$aName} if (defined($attr{$name}{$aName})); + if ($hash->{LeadingZeros}) { + if ($key =~ /([cdih])0*([0-9]+)/) { + my $type = $1; + my $adr = $2; + while (length($adr) <= 5) { + $aName = "obj-".$type.$adr."-".$oName; + Log3 $name, 5, "$name: ObjInfo check $aName"; + return $attr{$name}{$aName} + if (defined($attr{$name}{$aName})); + $adr = '0' . $adr; + } + } + } + return undef; +} + + +################################################ +# Get Object Info from Attributes, +# parseInfo Hash or default from deviceInfo Hash +sub Modbus_ObjInfo($$$;$$) { + my ($hash, $key, $oName, $defName, $lastDefault) = @_; + # Device h123 unpack defUnpack + $hash = $hash->{CHILDOF} if ($hash->{CHILDOF}); # take info from parent device if TCP server conn + my $name = $hash->{NAME}; + my $modHash = $modules{$hash->{TYPE}}; + my $parseInfo = $modHash->{parseInfo}; + #Log3 $name, 5, "$name: ObjInfo called from " . Modbus_Caller() . " for $key, object $oName" . + # ($defName ? ", defName $defName" : "") . ($lastDefault ? ", lastDefault $lastDefault" : ""); + + my $reading = Modbus_ObjAttr($hash, $key, 'reading'); + if (!defined($reading) && $parseInfo->{$key} && $parseInfo->{$key}{reading}) { + $reading = $parseInfo->{$key}{reading}; + } + if (!defined($reading)) { + #Log3 $name, 5, "$name: ObjInfo could not find a reading name"; + return (defined($lastDefault) ? $lastDefault : ""); + } + + #Log3 $name, 5, "$name: ObjInfo now looks at attrs for oName $oName / reading $reading / $key"; + if (defined($attr{$name})) { + # check for explicit attribute for this object + my $value = Modbus_ObjAttr($hash, $key, $oName); + return $value if (defined($value)); + + # check for special case: attribute can be name of reading with prefix like poll-reading + return $attr{$name}{$oName."-".$reading} + if (defined($attr{$name}{$oName."-".$reading})); + } + + # parseInfo for object $oName if special Fhem module using parseinfoHash + return $parseInfo->{$key}{$oName} + if (defined($parseInfo->{$key}) && defined($parseInfo->{$key}{$oName})); + + # check for type entry / attr ... + if ($oName ne "type") { + #Log3 $name, 5, "$name: ObjInfo checking types"; + my $dType = Modbus_ObjInfo($hash, $key, 'type', '', '***NoTypeInfo***'); + if ($dType ne '***NoTypeInfo***') { + #Log3 $name, 5, "$name: ObjInfo for $key and $oName found type $dType"; + my $typeSpec = Modbus_DevInfo($hash, "type-$dType", $oName, '***NoTypeInfo***'); + if ($typeSpec ne '***NoTypeInfo***') { + #Log3 $name, 5, "$name: ObjInfo $dType specifies $typeSpec for $oName"; + return $typeSpec; + } + } + #Log3 $name, 5, "$name: ObjInfo no type"; + } + # default for object type in deviceInfo / in attributes for device / type + if ($defName) { + #Log3 $name, 5, "$name: ObjInfo checking defaults Information defname=$defName"; + my $type = substr($key, 0, 1); + if (defined($attr{$name})) { + # check for explicit attribute for this object type + my $daName = "dev-".$type."-".$defName; + #Log3 $name, 5, "$name: ObjInfo checking $daName"; + return $attr{$name}{$daName} + if (defined($attr{$name}{$daName})); + + # check for default attribute for all object types + my $dadName = "dev-".$defName; + #Log3 $name, 5, "$name: ObjInfo checking $dadName"; + return $attr{$name}{$dadName} + if (defined($attr{$name}{$dadName})); + } + my $devInfo = $modHash->{deviceInfo}; + return $devInfo->{$type}{$defName} + if (defined($devInfo->{$type}) && defined($devInfo->{$type}{$defName})); + } + return (defined($lastDefault) ? $lastDefault : ""); +} + + +################################################ +# Get Type Info from Attributes, +# or deviceInfo Hash +sub Modbus_DevInfo($$$;$) { + my ($hash, $type, $oName, $lastDefault) = @_; + # Device h read + $hash = $hash->{CHILDOF} if ($hash->{CHILDOF}); # take info from parent device if TCP server conn + my $name = $hash->{NAME}; + my $modHash = $modules{$hash->{TYPE}}; + my $devInfo = $modHash->{deviceInfo}; + my $aName = "dev-".$type."-".$oName; + my $adName = "dev-".$oName; + + if (defined($attr{$name})) { + # explicit attribute for this object type + return $attr{$name}{$aName} + if (defined($attr{$name}{$aName})); + + # default attribute for all object types + return $attr{$name}{$adName} + if (defined($attr{$name}{$adName})); + } + # default for object type in deviceInfo + return $devInfo->{$type}{$oName} + if (defined($devInfo->{$type}) && defined($devInfo->{$type}{$oName})); + + return (defined($lastDefault) ? $lastDefault : ""); +} + + +################################################## +# Get Type/Adr for a reading name from Attributes, +# or parseInfo Hash +sub Modbus_ObjKey($$) { + my ($hash, $reading) = @_; + return undef if ($reading eq '?'); + + my $name = $hash->{NAME}; + my $modHash = $modules{$hash->{TYPE}}; + my $parseInfo = $modHash->{parseInfo}; + + foreach my $a (keys %{$attr{$name}}) { + if ($a =~ /obj-([cdih][0-9]+)-reading/ && $attr{$name}{$a} eq $reading) { + return $1; + } + } + foreach my $k (keys %{$parseInfo}) { + return $k if ($parseInfo->{$k}{reading} && ($parseInfo->{$k}{reading} eq $reading)); + } + return ""; +} + + +sub Modbus_CheckEval($\@$$) { + my ($hash, $valRef, $expr, $eName) = @_; + my $name = $hash->{NAME}; + my $inCheckEval = 1; + my @val = @{$valRef}; + my $val = $val[0]; + my $context = Modbus_Caller(); + my $desc = "$eName, val=@val, expr=$expr"; + my $result; + my $oldSig = ($SIG{__WARN__} ? $SIG{__WARN__} : 'DEFAULT'); + Log3 $name, 5, "$name: CheckEval for $context evaluates $desc"; + $SIG{__WARN__} = sub { + Log3 $name, 3, "$name: CheckEval for $context warning evaluating $desc: @_"; + }; + $result = eval($expr); + $SIG{__WARN__} = $oldSig; + if ($@) { + Log3 $name, 3, "$name: CheckEval for $context error evaluating $eName, val=$val, expr=$expr: $@"; + } else { + Log3 $name, 5, "$name: CheckEval for $context result is $result"; + } + return $result; +} + ##################################### -# called from logical device functions -# with log dev hash -sub ModbusLD_Send($$$;$$$){ - my ($hash, $objCombi, $op, $v1, $force, $reqLen) = @_; - # $hash : the logival Device hash - # $objCombi : type+adr - # $op : read, write or scanids/scanobj - # $v1 : value for writing (already packed) - # $force : put in front of queue and don't reschedule but wait if necessary - - my $name = $hash->{NAME}; # name of logical device - my $devId = ($op =~ /^scanid([0-9]+)/ ? $1 : $hash->{MODBUSID}); - my $proto = $hash->{PROTOCOL}; - my $ioHash = ModbusLD_GetIOHash($hash); - my $type = substr($objCombi, 0, 1); - my $adr = substr($objCombi, 1); - my $reading = ModbusLD_ObjInfo($hash, $objCombi, "reading"); - my $objLen = ModbusLD_ObjInfo($hash, $objCombi, "len", "defLen", 1); - my $fcKey = $op; - if ($op =~ /^scan/) { - $objLen = $reqLen; # for scan there is no objLen but reqLen is given - avoid confusing log and set objLen ... - $fcKey = 'read'; - } - - return if (!$ioHash); - my $ioName = $ioHash->{NAME}; - my $qlen = ($ioHash->{QUEUE} ? scalar(@{$ioHash->{QUEUE}}) : 0); - - Log3 $name, 3, "$name: _Send called but IO Device is disabled" if (IsDisabled ($ioName)); +sub Modbus_Statistics($$$) +{ + my ($hash, $key, $value) = @_; + my $name = $hash->{NAME}; - Log3 $name, 4, "$name: Send called with $type$adr, objLen $objLen / reqLen " . - ($reqLen ? $reqLen : "-") . " to id $devId, op $op, qlen $qlen" . - ((defined($v1) && $op eq 'write') ? ", value hex " . unpack ('H*', $v1) : ""); - $reqLen = $objLen if (!$reqLen); # reqLen given as parameter (only for combined read requests from GetUpdate or scans) - - my $unpack = ModbusLD_ObjInfo($hash, $objCombi, "unpack", "defUnpack", "n"); - if ($objLen < 2 && $unpack =~ /lLIqQfFNVD/) { - Log3 $name, 3, "$name: _Send with unpack $unpack but len seems too small - please set obj-${objCombi}-Len!"; - } - - if ($qlen && AttrVal($ioName, "dropQueueDoubles", 0)) { - Log3 $name, 5, "$name: Send is checking if request is already in queue ($qlen requests)"; - foreach my $elem (@{$ioHash->{QUEUE}}) { - Log3 $name, 5, "$name: is it $elem->{TYPE} $elem->{ADR} reqLen $elem->{LEN} to id $elem->{MODBUSID}?"; - if($elem->{ADR} == $adr && $elem->{TYPE} eq $type - && $elem->{LEN} == $reqLen && $elem->{MODBUSID} eq $devId) { - Log3 $name, 4, "$name: request already in queue - dropping"; - return; - } + my $pInterval = AttrVal($name, "profileInterval", 0); + return if (!$pInterval); + + my $now = gettimeofday(); + my $pPeriod = int($now / $pInterval); + + if (!defined ($hash->{statistics}{lastPeriod}) || ($pPeriod != $hash->{statistics}{lastPeriod})) { + readingsBeginUpdate($hash); + foreach my $k (keys %{$hash->{statistics}{sums}}) { + readingsBulkUpdate($hash, "Statistics_" . $k, $hash->{statistics}{sums}{$k}); + $hash->{statistics}{sums}{$k} = 0; } - } - - my $tid = int(rand(255)); - my %request; - $request{DEVHASH} = $hash; # logical device in charge - $request{TYPE} = $type; # type of object (cdih) - $request{ADR} = $adr; # address of object - $request{LEN} = $reqLen; # number of registers / length of object - $request{READING} = $reading; # reading name of the object - $request{TID} = $tid; # transaction id for Modbus TCP - $request{PROTOCOL} = $proto; # RTU / ASCII / ... - $request{MODBUSID} = $devId; # ModbusId of the addressed device - coming from logical device hash - $request{VALUE} = $v1; # Value to be written (set) - $request{OPERATION} = $op; # read / write / scan - - my $fCode = ModbusLD_DevInfo($hash, $type, $fcKey, $Modbus_defaultFCode{$type}{$fcKey}); - if (!$fCode) { - Log3 $name, 3, "$name: Send did not find fCode for $fcKey type $type"; - return; - } - $request{FCODE} = $fCode; # function code - - Log3 $name, 4, "$name: Send" . - ($force ? " adds " : " queues ") . - "fc $fCode to $devId" . - ($proto eq "TCP" ? ", tid $tid" : "") . ", for $type$adr" . - ($reading ? " ($reading)" : "") . ", reqLen $reqLen" . - ((defined($v1) && $op eq 'write') ? ", value hex " . unpack ('H*', $v1) : "") . - ($force ? " at beginning of queue for immediate sending" : ""); - - if(!$qlen) { - #Log3 $name, 5, "$name: Send is creating new queue"; - $ioHash->{QUEUE} = [ \%request ]; + readingsEndUpdate($hash, 1); + $hash->{statistics}{sums}{$key} = $value; + $hash->{statistics}{lastPeriod} = $pPeriod; } else { - #Log3 $name, 5, "$name: Send initial queue length is $qlen"; - if ($qlen > AttrVal($name, "queueMax", 100)) { - Log3 $name, 3, "$name: Send queue too long ($qlen), dropping new request"; + if ($hash->{statistics}{sums}{$key}) { + $hash->{statistics}{sums}{$key} += $value; } else { - if ($force) { - unshift (@{$ioHash->{QUEUE}}, \%request); # an den Anfang - } else { - push(@{$ioHash->{QUEUE}}, \%request); # ans Ende - } + $hash->{statistics}{sums}{$key} = $value; } } - Modbus_HandleSendQueue("direct:".$ioName, $force); # name is physical device return; -} +} + + +##################################### +sub Modbus_Profiler($$) +{ + my ($hash, $key) = @_; + return if (!$hash); + my $name = $hash->{NAME}; + + my $pInterval = AttrVal($name, "profileInterval", 0); + return if (!$pInterval); + + my $now = gettimeofday(); + my $pPeriod = int($now / $pInterval); + #my $micros = $now - (int ($now)); + #my ($seconds, $minute, $hour, @rest) = localtime ($now); + + # erster Aufruf? dann lastKey setzen und Startzeit merken, lastPeriod setzen + if (!defined ($hash->{profiler}{lastKey})) { + $hash->{profiler}{lastKey} = $key; + $hash->{profiler}{lastPeriod} = $pPeriod; + $hash->{profiler}{start}{$key} = $now; + $hash->{profiler}{sums}{$key} = 0 ; + Log3 $name, 5, "$name: Profiling $key initialized, start $now"; + return; + } + + # merke letzten Key - für diesen ist bisher die Zeit vergangen + my $lKey = $hash->{profiler}{lastKey}; + + # für den letzten Key: Diff seit Start + my $lDiff = ($now - $hash->{profiler}{start}{$lKey}); + $lDiff = 0 if (!$hash->{profiler}{start}{$lKey}); + + # für den neuen Key: wenn noch kein start, dann startet die Messung jetzt + if (!$hash->{profiler}{start}{$key}) { + $hash->{profiler}{start}{$key} = $now; + } + + Log3 $name, 5, "$name: Profiling $key, before $lKey, now is $now, $key started at " + . $hash->{profiler}{start}{$key} . ", $lKey started at " . $hash->{profiler}{start}{$lKey}; + + # neue Minute + if ($pPeriod != $hash->{profiler}{lastPeriod}) { + my $overP = $now - ($pPeriod * $pInterval); # time over the pPeriod start + $overP = 0 if ($overP > $lDiff); # if interval was modified things get inconsistant ... + Log3 $name, 5, "$name: Profiling pPeriod changed, last pPeriod was " . $hash->{profiler}{lastPeriod} . + " now $pPeriod, total diff for $lKey is $lDiff, over $overP over the pPeriod"; + Log3 $name, 5, "$name: Profiling add " . ($lDiff - $overP) . " to sum for $key"; + $hash->{profiler}{sums}{$lKey} += ($lDiff - $overP); + + readingsBeginUpdate($hash); + foreach my $k (keys %{$hash->{profiler}{sums}}) { + my $val = sprintf("%.2f", $hash->{profiler}{sums}{$k}); + Log3 $name, 5, "$name: Profiling set reading for $k to $val"; + readingsBulkUpdate($hash, "Profiler_" . $k . "_sum", $val); + $hash->{profiler}{sums}{$k} = 0; + $hash->{profiler}{start}{$k} = 0; + } + readingsEndUpdate($hash, 0); + + $hash->{profiler}{start}{$key} = $now; + + Log3 $name, 5, "$name: Profiling set new sum for $lKey to $overP"; + $hash->{profiler}{sums}{$lKey} = $overP; + $hash->{profiler}{lastPeriod} = $pPeriod; + $hash->{profiler}{lastKey} = $key; + } else { + if ($key eq $hash->{profiler}{lastKey}) { + # nothing new - take time when key or pPeriod changes + return; + } + Log3 $name, 5, "$name: Profiling add $lDiff to sum for $lKey " . + "(now is $now, start for $lKey was $hash->{profiler}{start}{$lKey})"; + $hash->{profiler}{sums}{$lKey} += $lDiff; + $hash->{profiler}{start}{$key} = $now; + $hash->{profiler}{lastKey} = $key; + } + return; +} + + +########################################################### +# return the name of the caling function for debug output +sub Modbus_Caller() +{ + my ($package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext, $is_require, $hints, $bitmask, $hinthash) = caller 2; + return $1 if ($subroutine =~ /main::Modbus_(.*)/); + return $1 if ($subroutine =~ /main::(.*)/); + + return "$subroutine"; +} + + + +# Try to convert a value with a map +# called from Set and FormatReading +######################################### +sub Modbus_MapConvert($$$;$) +{ + my ($hash, $map, $val, $reverse) = @_; + my $name = $hash->{NAME}; + + if ($reverse) { + $map =~ s/([^, ][^,\$]*):([^,][^,\$]*),? */$2:$1, /g; # reverse map + } + # spaces in words allowed, separator is ',' or ':' + $val = decode ('UTF-8', $val); # convert nbsp from fhemweb + $val =~ s/\s| / /g; # back to normal spaces in case it came from FhemWeb with coded Blank + + my %mapHash = split (/, *|:/, $map); # reverse hash aus dem reverse string + + if (defined($mapHash{$val})) { # Eintrag für den übergebenen Wert in der Map? + my $newVal = $mapHash{$val}; # entsprechender Raw-Wert für das Gerät + Log3 $name, 5, "$name: MapConvert called from " . Modbus_Caller() . " converted $val to $newVal with" . + ($reverse ? " reversed" : "") . " map $map"; + return $newVal; + } else { + Log3 $name, 3, "$name: MapConvert called from " . Modbus_Caller() . " did not find $val in" . + ($reverse ? " reversed" : "") . " map $map"; + return undef; + } +} + + +# called from UpdateHintList +######################################### +sub Modbus_MapToHint($) +{ + my ($map) = @_; + my $hint = $map; # create hint from map + $hint =~ s/([^,\$]+):([^,\$]+)(,?) */$2$3/g; # allow spaces in names + $hint =~ s/\s/ /g; # convert spaces for fhemweb + return $hint; +} + + 1; @@ -2834,14 +4909,24 @@ sub ModbusLD_Send($$$;$$$){
  • do_not_notify
  • readingFnAttributes

    • +
  • queueMax
    • + max length of the queue used for sending requests, defaults to 200.
  • queueDelay
    • - modify the delay used when sending requests to the device from the internal queue, defaults to 1 second
    + modify the delay used when sending requests to the device from the internal queue, defaults to 1 second +
  • queueTimeout
    • + modify the timeout used to remove old entries in the send queue for requests. By default entries that cound not be sent for more than 20 seconds will be deleted from the queue +
  • enableQueueLengthReading
    • + if set to 1 the physical device will create a reading with the length of the queue ued internally to send requests.
    +
  • busDelay
    • - defines a delay that is always enforced between the last read from the bus and the next send to the bus for all connected devices
    + defines a delay that is always enforced between the last read from the bus and the next send to the bus for all connected devices
  • clientSwitchDelay
    • - defines a delay that is always enforced between the last read from the bus and the next send to the bus for all connected devices but only if the next send goes to a different device than the last one
    + defines a delay that is always enforced between the last read from the bus and the next send to the bus for all connected devices but only if the next send goes to a different device than the last one
  • dropQueueDoubles
    • - prevents new request to be queued if the same request is already in the send queue
    + prevents new request to be queued if the same request is already in the send queue +
  • retriesAfterTimeout
    • + tbd. +
  • skipGarbage
    • if set to 1 this attribute will enhance the way the module treats Modbus response frames (RTU over serial lines) that look as if they have a wrong Modbus id as their first byte. If skipGarbage is set to 1 then the module will skip all bytes until a byte with the expected modbus id is seen. Under normal circumstances this behavior should not do any harm and lead to more robustness. However since it changes the original behavior of this module it has to be turned on explicitely.
    For Modbus ASCII it skips bytes until the expected starting byte ":" is seen. @@ -2874,3 +4959,4 @@ sub ModbusLD_Send($$$;$$$){ =end html =cut + diff --git a/fhem/FHEM/98_ModbusAttr.pm b/fhem/FHEM/98_ModbusAttr.pm index f691b81f1..919fc8be2 100755 --- a/fhem/FHEM/98_ModbusAttr.pm +++ b/fhem/FHEM/98_ModbusAttr.pm @@ -39,6 +39,8 @@ # 2017-03-12 fixed documentation for logical attrs that were wrongly defined as physical ones # 2017-07-15 added documentation for new attributes # 2017-07-25 documentation for data type attributes +# 2018-08-24 started documenting the new features of the base Modbus module version 4 +# 2018-11-10 fixed doku for defSetexpr # package main; @@ -67,57 +69,169 @@ ModbusAttr_Initialize($) =pod =item device -=item summary module for devices with Modbus Interface -=item summary_DE Modul für Geräte mit Modbus-Interface +=item summary module for Modbus (as master, slave, relay, or for passive listening) +=item summary_DE Modul für Modbus (als Master, Slave, Relay oder zum Mitlesen) =begin html +

    ModbusAttr

      - ModbusAttr uses the low level Modbus module 98_Modbus.pm to provide a generic Modbus module for devices that can be defined by attributes similar to the way HTTPMOD works for devices with a web interface. + ModbusAttr uses the low level Modbus module 98_Modbus.pm to provide a generic Modbus module (as master, slave, relay or passive listener)
      + that can be configured by attributes similar to the way HTTPMOD works for devices with a web interface.
      + ModbusAttr can be used as a Modbus master that queries data from other devices over a serial RS232 / RS485 or TCP connection,
      + it can be used as a Modbus slave that can make readings of Fhem devices available via Modbus to external Modbus masters,
      + it can act as aModbus relay that receives requests over one connection and forwards them over another connection (e.g. from Modbus TCP to serial Modbus RTU)
      + or it can passively listen to other devices that communicate over a serial RS485 connection and extract readings from the objects it sees.
      + The supported protocols are Modbus RTU, Modbus ASCII or Modbus TCP.
      + There are several attributes that modify the way data objects are converted before they are stored in readings or sent to a device. Data can be modified by a perl expression defined in an atribute, formatted with a format string defined in another attribute or mapped to a table defined in an attribute.
      + Readings can directly correspond to one data object or they can span several objects. A float value for example might be stored in two input or holding registers in the Modbus device. By specifying attributes that define the length of a reading in objects and by specifying the unpack code to get from a raw string to perl variables, all these cases can be described by attributes and no perl coding is necessary. +

      Prerequisites
      • - This module requires the basic Modbus module which itsef requires DevIO which again requires Device::SerialPort or Win32::SerialPort module if you connect devices to a serial port. + This module requires the basic Modbus module which itsef requires DevIO which again requires Device::SerialPort or Win32::SerialPort module if you connect devices to a serial port (RS232 or RS485).

      - Define + Define as Modbus master
        - define <name> ModbusAttr <Id> <Interval>
        + + define Modbus /dev/device@baudrate,bits,parity,stop
        + define <name> ModbusAttr <Id> <Interval> +
        or
        - define <name> ModbusAttr <Id> <Interval> <Address:Port> <RTU|ASCII|TCP>
        -
        - The module connects to the Modbus device with Modbus Id <Id> through an already defined serial modbus device (RS232 or RS485) or directly through Modbus TCP or Modbus RTU or ASCII over TCP and actively requests data from that device every <Interval> seconds
        + + define <name> ModbusAttr <Id> <Interval> <Address:Port> <RTU|ASCII|TCP> +
        + + In the first case the module connects to the external Modbus device with Modbus Id <Id> through the serial modbus device (RS232 or RS485). Therefore a physical [[Modbus]] device is defined first
        + In the second case the module connects directly through Modbus TCP or Modbus RTU or ASCII over TCP.
        + If <Interval> is not 0 then the module actively requests data from the external device every <Interval> seconds
        + The objects that the module should request and the readings it should create from these objects have to be defined with attributes (see below).
        + These attributes will define a mapping from so called "coils", "digital inputs", "input registers" or "holding registers" of the external device to readings inside Fhem together with the data type and format of the values.
        + Interval can be 0 in which case the Module only requests data when it is triggered with a Fhem get-Command.
        + With this mode a Fhem installation can for example query sensor data from a heating system, energy meter or solar power installation if these systems offer a Modbus interface.
        Examples:

        -
          define WP ModbusAttr 1 60

        - to go through a serial interface managed by an already defined basic modbus device. The protocol defaults to Modbus RTU
        +
          + define ModbusLine Modbus /dev/ttyUSB1@9600
          + define WP ModbusAttr 1 60 +

        + Define WP as a Modbus master that communicates through the Modbus serial interface device named ModbusLine. The protocol defaults to Modbus RTU
        or
        -
          define WP ModbusAttr 20 0 ASCII

        - to go through a serial interface managed by an already defined basic modbus device with Modbus ASCII. Use Modbus Id 20 and don't query the device in a defined interval. Instead individual SET / GET options have to be used for communication.
        +
          + define ModbusLine Modbus /dev/ttyUSB1@9600
          + define WP ModbusAttr 20 0 ASCII +

        + + Define WP as a Modbus master that communicates through the Modbus serial interface device named ModbusLine with Modbus ASCII. + Use Modbus Id 20 and don't query the device in a defined interval. Instead individual SET / GET options have to be used for communication.
        or
        -
          define WP ModbusAttr 5 60 192.168.1.122:504 TCP

        - to talk Modbus TCP
        +
          define WP ModbusAttr 5 60 192.168.1.122:502 TCP

        + to talk Modbus TCP to a device with IP-Address 192.168.1.122 and the reserved port for Modbus TCP 502
        + Note that for Modbus over a TCP connection you don't need a basic Modbus device for the interface like ModbusLine above.
        or
          define WP ModbusAttr 3 60 192.168.1.122:8000 RTU

        - to talk Modbus RTU over TCP
        + to talk Modbus RTU over TCP and use the port number 8000

      - - Configuration of the module

      + Define as Modbus slave
        - The data objects (holding registers, input registers, coils or discrete inputs) of the device to be queried are defined using attributes. - The attributes assign objects with their address to readings inside fhem and control - how these readings are calculated from the raw values and how they are formatted.
        - Objects can also be written to the device and attributes define how this is done.

        + define <name> ModbusAttr <Id> slave
        + or
        + define <name> ModbusAttr <Id> slave <Address:Port> <RTU|ASCII|TCP>
        +
        + The module waits for connections from other Modbus masters. It will respond to their requests if the requests contain the given Modbus <Id>
        + To provide data with Modbus to external Modbus masters a mapping needs to be defined using attributes. + These attributes will define a mapping from Readings inside Fhem to so called "coils", "digital inputs", "input registers" or "holding registers" and their Modbus object address together with the data type and format of the values.
        + With this mode a Fhem installation can for example supply data to a PLC that actively reads data from Fhem or writes data to Fhem readings. +
        + Examples:
        +
        +
          define MRS485 Modbus /dev/ttyUSB2@9600,8,E,1
          + define Data4PLC ModbusAttr 1 slave

        + Define Data4PLC as a Modbus slave that communicates through the Modbus serial interface device named MRS485 to listen for Modbus requests with Id 1. The protocol defaults to Modbus RTU
        + or
        +
          define MRS485 Modbus /dev/ttyUSB2@9600,8,E,1
          + define Data4PLC ModbusAttr 20 slave ASCII

        + to listen for Modbus requests with Id 20 with Modbus ASCII.
        + or
        +
          define Data4PLC ModbusAttr 5 slave 192.168.1.2:502 TCP

        + to start listening to TCP port 502 on the local address 192.168.1.2. Modbus TCP will be used as protocol and Requests with Modbus Id 5 will be answered.
        + Please be aware that opening a port number smaller than 1024 needs root permissions on Unix devices. So it is probably better to use a non standard port number above 1024 instead.
        + or
        +
          define Data4PLC ModbusAttr 3 slave 192.168.1.2:8000 RTU

        + to listen to the local port 8000 and talk Modbus RTU over TCP
        +
      +
      + + Define as Modbus passive listener +
        + define <name> ModbusAttr <Id> passive <RTU|ASCII|TCP>
        +
        + The module listens on a serial (RS485) connection for modbus communication with the given Modbus <Id> and extracts readings. It does not send requests by itself but waits for another master to communicate with a slave. So only objects that the other master requests can be seen by Fhem in this configuration.
        + The objects that the module recognizes and the readings that it should create from these objects have to be defined with attributes (see below) in the same way as for a Modbus master.
        + These attributes will define a mapping from so called "coils", "digital inputs", "input registers" or "holding registers" of the external device to readings inside Fhem together with the data type and format of the values.
        + With this mode a Fhem installation can for example Listen to the communication between an energy counter as slave and a solar control system as master if they use Modbus RTU over RS485. Since only one Master is allowed when using Modbus over serial lines, Fhem can not be master itself. As a passive listener it can however see when the master queries e.g. the current power consumption and then also see the reply from the energy meter and store the value in a Fhem reading. +
        + Examples:
        +
        +
          define MB-485 Modbus /dev/ttyUSB2
          + define WP ModbusAttr 1 passive

        + to passively listen for Modbus requests and replies with Id 1 over a serial interface managed by an already defined basic modbus device named MB-485. The protocol defaults to Modbus RTU
        + or
        +
          define MB-485 Modbus /dev/ttyUSB2
          + define WP ModbusAttr 20 passive ASCII

        + to passivel listen for Modbus requests / replies with Id 20 and Modbus ASCII.
        +
      +
      + + Define as Modbus relay +
        + define <name> ModbusAttr <Id> relay to <FhemMasterDevice>
        + or
        + define <name> ModbusAttr <Id> relay <Address:Port> <RTU|ASCII|TCP> to <FhemMasterDevice>
        +
        + The module waits for connections from other Modbus masters. It will forward requests if they match the given Modbus <Id> to an already defined Modbus Master device inside Fhem which will send them to its defined slave, take the reply and the pass it back to the original Master.
        + With this mode a Fhem installation can for example be used in front of a device that only speaks Modbus RTU over RS485 to make it available via Modbus TCP over the local network. +
        + Examples:
        +
        +
          define MB-485 Modbus /dev/ttyUSB2
          + define Heating ModbusAttr 22 0
          + define Relay ModbusAttr 33 relay 192.168.1.2:1502 TCP to Heating

        + Defines MB-485 as a base device for the RS-485 communication with a heating system,
        + defines Heating as a Modbus Master to communicate with the Heating and its Modbus ID 22,
        + and then defines the relay which listens to the local IP address 192.168.1.2, TCP port 1502, Modbus Id 33 and protocol Modbus-TCP.
        + Requests coming in through Modbus TCP and port 1502 are then translated to Modbus RTU and forwarded via RS-485 to the heating system with Modbus Id 22.
        + or (unlikely)
        +
          define MB-232 Modbus /dev/ttyUSB2@19200
          + define Solar ModbusAttr 7 0 192.168.1.122:502 RTU
          + define PLC2NetRelay ModbusAttr 1 ASCII relay to Solar

        + Defines MB-232 as a base device for the RS-232 communication with a PLC as Modbus master,
        + defines Solar as a Modbus Master to communicate with Modbus TCP to a Solar power system at IP Adrress 192.168.1.122 and its Modbus ID 7,
        + and then defines the PLC2NetRelay as a relay which listens to Modbus-ASCII requests over the serial RS-232 link from a PLC to Modbus ID 1.
        + Requests to Modbus Id 1 coming in through the serial link are then translated to Modbus TCP and forwarded over the network to the solar power system with Modbus Id 7.
        +
      +
      + + + + Configuration of the module as master or passive listener +
        + Data objects (holding registers, input registers, coils or discrete inputs) are defined using attributes. + If Fhem is Modbus master or passive listener, the attributes assign data objects of external devices (heating systems, power meters, PLCs or other) with their register addresses to readings inside fhem and control how these readings are calculated from the raw values and how they are formatted.
        + Please be aware that Modbus does not define common data types so the representation of a value can be very different from device to device. One device might make a temperature value avaliable as a floating point value that is stored in two holding resgisters, another device might store the temperature multiplied with 10 as an signed integer in one register. Even the order of bytes can vary.
        + Therefore it is typically necessary to specify the data representation as a Perl unpack code.
        + A Modbus master can also write values to Objects in the device and attributes define how this is done.

        - Example:
        + Example for a Modbus master or passive configuration:
                 define PWP ModbusAttr 5 30
         attr PWP obj-h256-reading Temp_Wasser_ein
@@ -139,6 +253,7 @@ ModbusAttr_Initialize($)
 
         attr PWP dev-h-combine 5
         attr PWP dev-h-defPoll 1
+        attr PWP dev-h-defUnpack n
 
         attr PWP room Pool-WP
         attr PWP stateFormat {sprintf("%.1f Grad", ReadingsVal($name,"Temp_Wasser_Ein",0))}
@@ -161,6 +276,9 @@ ModbusAttr_Initialize($)
         Thus h770 refers to a holding register with the decimal address 770 and c120 refers to a coil with address 120. 
         The address has to be specified as pure decimal number. The address counting starts at address 0

        
         
+        Please note that the documentation for devices sometimes uses different numbering. They might start counting with one instead of zero so if a voltage value is stored in input register number 107 according to the documentation of the device, it might technically mean register number 106 (in the Modbus protocol specification addresses start with 0).
        
+        Also some vendors use hexadecimal descriptions of their register addresses. So input register 107 might be noted as hex and means 263 or even 262 as decimal address.
        
+        
         attr PWP obj-h258-reading Temp_Wasser_Aus defines a reading with the name Temp_Wasser_Aus that is read from the Modbus holding register at address 258.
        
         With the attribute ending on -expr you can define a perl expression to do some conversion or calculation on the raw value read from the device. 
         In the above example the raw value has to be devided by 10 to get the real value. If the raw value is also the final value then no -expr attribute is necessary. 

        
@@ -177,15 +295,96 @@ ModbusAttr_Initialize($)
         These attributes are optional and the module will use defaults that work in most cases. 
        
         dev-h-combine 5 for example allows the module to combine read requests to objects having an address that differs 5 or less into one read request. 
         Without setting this attribute the module will start individual read requests for each object. 
-        Typically the documentation for the modbus interface of a given device states the maximum number of objects that can be read in one function code 3 request.      
+        Typically the documentation for the modbus interface of a given device states the maximum number of objects that can be read in one function code 3 request.
        
+        dev-h-defUnpack n means that the values in this example that the values are stored as unsigned short (16-bit) in "network" (big-endian) order. This is only one possibility of many. An integer value might be signed instead of unsigned or it might use different byte ordering (e.g. unpack codes v or s).
      - +
      + + + Handling Data Types +
        + The Modbus protocol does not define data types. If the documentation of a device states that for example the current temperature is stored in holding register 102 this leaves room for many interpretations. Not only can the address 102 mean different things (actually decimal 102 or rather 101 if the vendor starts counting at 1 instead of 0 or even 257 or 258 if the vendor used hexadecimal addresses in his documentation ) also the data representation can be many different things. As in every programming language, there are many ways to represent numbers. They can be stored signed or unsigned, they can be integers or floating point numbers, the byte-order can be "big endian" or "small endian", the value can be stored in one holding register or in two holding registers (floating point numbers typically take four bytes which means two holding registers).
        + The Modbus module allows flexible configuration of data representations be assigning a Perl unpack-code, a length, a Perl Expression, and the register ordering. The following example illustrates how this can be done:
        + 
        +        attr PWP obj-h338-reading Pressure
+        attr PWP obj-h338-len 2
+        attr PWP obj-h338-unpack f>
+        attr PWP obj-h338-revRegs 1
+        attr PWP obj-h338-format %.2f
+
        + In This example a floating point value for the reading "Pressure" is read from the holding registers starting at address 338. + The value occupies 32 Bits and is therefore stored in two registers. The Perl pack code to use is f> which means a native single precision float in big endian format (byte order). With revRegs the module is instructed to reverse the order of the registers directly after reading. The format specification then defines how the value is formatted into a reading - in this case with two digits after the comma. See http://perldoc.perl.org/functions/pack.html for Perl pack / unpack codes and http://perldoc.perl.org/functions/sprintf.html for format specifications.
        +
        + If you need to read / write many objects for a device, defining all these parameters each time is not elegant. The Modbus module therefore offers twi ways to simplify this task:
        + You can define defaults for every type of object or you can define your own data types once and then refer to them.
        + This exampe shows how defaults can be specified for holding registers and input registers:
        + 
        +        attr PWP dev-h-defUnpack f>
+        attr PWP dev-h-defLen 2
+        attr PWP dev-h-defRevRegs 1
+        attr PWP dev-h-defFormat %.2f
+        
+        attr PWP dev-i-defUnpack n
+        attr PWP dev-i-defLen 1
+
        +
        + The next example shows how you can define your own data types and then apply them to objects:
        + 
        +        attr WP dev-type-VT_R4-format %.1f
+        attr WP dev-type-VT_R4-len 2
+        attr WP dev-type-VT_R4-revRegs 1
+        attr WP dev-type-VT_R4-unpack f>
+        
+        attr WP obj-h1234-reading Temp_In
+        attr WP obj-h1234-type VT_R4
+        attr WP obj-h1236-reading Temp_Out
+        attr WP obj-h1236-type VT_R4
+
        + This example defines a data type with the name VT_R4 which uses an unpack code of f>, length 2 and reversed register ordering. It then assigns this Type to the objects Temp_In and Temp_Out.
        +
        +
      +
      + + + Configuration of the module as Modbus slave +
        + Data objects that the module offers to external Modbus masters (holding registers, input registers, coils or discrete inputs) are defined using attributes. + If Fhem is Modbus slave, the attributes assign readings of Fhem devices to Modbus objects with their addresses and control how these objects are calculated from the reading values that exist in Fhem.
        + It is also possible to allow an external Modbus master to send write function codes and change the value of readings inside Fhem. + + Example for a Modbus slave configuration:
        + 
        +        define MRS485 Modbus /dev/ttyUSB2@9600,8,E,1
+        define Data4PLC ModbusAttr 1 slave
+        attr Data4PLC IODev MRS485
+        
+        attr Data4PLC obj-h256-reading THSensTerrasse:temperature
+        attr Data4PLC obj-h256-unpack f
+        attr Data4PLC obj-h256-len 2
+        
+        attr Data4PLC obj-h258-reading THSensTerrasse:humidity
+        attr Data4PLC obj-h258-unpack f
+        attr Data4PLC obj-h258-len 2
+        
+        attr Data4PLC obj-h260-reading myDummy:limit
+        attr Data4PLC obj-h260-unpack n
+        attr Data4PLC obj-h260-len 1
+        attr Data4PLC obj-h260-allowWrite 1
+
        + + In this example Fhem allows an external Modbus master to read the temperature of a Fhem device named THSensTerrasse through holding register 256 and the humidity of that Fhem device through holding register 258. Both are encoded as floting point values that span two registers.
        + The master can also read but also write the reading named limit of the device myDummy. + +
      +
      + - Set-Commands
      + Set-Commands for Fhem as Modbus master operation
        are created based on the attributes defining the data objects.
        Every object for which an attribute like obj-xy-set is set to 1 will create a valid set option.
        - Additionally the attribute enableControlSet enables the set options interval, stop, start, reread as well as scanModbusObjects, scanStop and scanModbusIds (for devices connected with RTU / ASCII over a serial line). + Additionally the attribute enableControlSet enables the set options interval, stop, start, reread as well as scanModbusObjects, scanStop and scanModbusIds (for devices connected with RTU / ASCII over a serial line).
        + Starting with Version 4 of the Modbus module enableControlSet defaults to 1.
        • interval <Interval>
          • modifies the interval that was set during define. @@ -222,7 +421,7 @@ ModbusAttr_Initialize($)

        - Get-Commands
        + Get-Commands for Modbus master operation
          All readings are also available as Get commands. Internally a Get command triggers the corresponding request to the device and then interprets the data and returns the right field value. @@ -238,7 +437,8 @@ ModbusAttr_Initialize($)
        • alignTime
          • Aligns each periodic read request for the defined interval to this base time. This is typcally something like 00:00 (see the Fhem at command)
        • enableControlSet
          • - enables the built in set commands like interval, stop, start and reread (see above) + enables the built in set commands like interval, stop, start and reread (see above).
          + Starting with Version 4 of the Modbus module enableControlSet defaults to 1. This attribute can however be used to disable the set commands by setting the attribute to 0

          please also notice the attributes for the physical modbus interface as documented in 98_Modbus.pm @@ -248,73 +448,80 @@ ModbusAttr_Initialize($) For many attributes you can also specify default values per object type (see dev- attributes later) or you can specify an object attribute without type and address (e.g. obj-len) which then applies as default for all objects:
        • obj-[cdih][1-9][0-9]*-reading
          • - define the name of a reading that corresponds to the modbus data object of type c,d,i or h and a decimal address (e.g. obj-h225-reading). -
          + define the name of a reading that corresponds to the modbus data object of type c,d,i or h and a decimal address (e.g. obj-h225-reading).
          + For master or passive operation this reading name will be used to create a reading for the modbus device itself.
          + For slave operation this can also be specified as deviceName:readingName to refer to the reading of another device inside Fhem whose value can be queried by an external Modbus master with the goven type and address.
        • obj-[cdih][1-9][0-9]*-name
          • - defines an optional internal name of this data object (this has no meaning for fhem and serves mainly documentation purposes. -
          + defines an optional internal name of this data object (this has no meaning for fhem and serves mainly documentation purposes.
        • obj-[cdih][1-9][0-9]*-set
          • - if set to 1 then this data object can be changed (works only for holding registers and coils since discrete inputs and input registers can not be modified by definition. -
          + if set to 1 then this data object can be changed with a Fhem set command + which results in a modbus write request sent to the external slave device.
          + (works only if this device is a modbus master and for holding registers and coils + since discrete inputs and input registers can not be modified by definition).
        • obj-[cdih][1-9][0-9]*-min
          • - defines a lower limit to the value that can be written to this data object. This ist just used for input validation. -
          + this defines a lower limit to the value of this data object
          + If in master mode this applies to values written with a Fhem set command to an external slave device and is used for input validation.
          + If in slave mode this applies to values written by an external master device to Fhem readings.
        • obj-[cdih][1-9][0-9]*-max
          • - defines an upper limit to the value that can be written to this data object. This ist just used for input validation. -
          + this defines an upper limit to the value of this data object
          + If in master mode this applies to values written with a Fhem set command to an external slave device and is used for input validation.
          + If in slave mode this applies to values written by an external master device to Fhem readings.
        • obj-[cdih][1-9][0-9]*-hint
          • - this is used for set options and tells fhemweb what selection to display for the set option (list or slider etc.) -
          + this is used in master mode for set options and tells fhemweb what selection to display for the set option (list or slider etc.)
        • obj-[cdih][1-9][0-9]*-expr
          • - defines a perl expression that converts the raw value read from the device. -
          -
        • obj-[cdih][1-9][0-9]*-ignoreExpr
          • - defines a perl expression that returns 1 if a value should be ignored and the existing reading should not be modified -
          -
        • obj-[cdih][1-9][0-9]*-map
          • - defines a map to convert values read from the device to more convenient values when the raw value is read from the device - or back when the value to write has to be converted from the user value to a raw value that can be written. - Example: 0:mittig, 1:oberhalb, 2:unterhalb -
          + In master mode this defines a perl expression that converts the raw value read from an external slave device into a value that is stored in a Fhem reading.
          + In slave mode this defines a perl expression that converts the raw value written from an external master device into a value that is stored in a Fhem reading.
          + Inside the expression you can use $val to get the value or the array @val in case there are several values (e.g. when unpack produces more than one value)
        • obj-[cdih][1-9][0-9]*-setexpr
          • - defines a perl expression that converts the user specified value in a set to a raw value that can be sent to the device. - This is typically the inversion of -expr above. -
          + In master mode this defines a perl expression that converts the user specified value from the set command + to a raw value that can be sent to the external slave device with a write function code.
          + In slave mode this defines a perl expression that converts the value of a reading inside Fhem to a raw value that can be sent to the device + as a response to the read function code received from the external master device.
          + This is typically the inversion of -expr above.
          +
        • obj-[cdih][1-9][0-9]*-allowWrite
          • + this only applies to a Fhem Modbus device in slave mode. + If set to 1 it defines that a reading can be changed with a write function code by an external modbus master.
          +
        • obj-[cdih][1-9][0-9]*-ignoreExpr
          • + defines a perl expression that returns 1 if a value should be ignored and the existing reading should not be modified
          + In master mode this applies to values read from an external slave device.
          + In slave mode this applies to values written to Fhem readings by an external master device.
          + Inside the expression you can use $val to get the value or the array @val in case there are several values (e.g. when unpack produces more than one value)
          +
        • obj-[cdih][1-9][0-9]*-map
          • + In master mode defines a map to convert raw values read from an external device to more convenient strings that are then stored in Fhem readings + or back (as reversed map) when a value to write has to be converted from the user set value to a raw value that can be written.
          + In slave mode defines a map to convert raw values received from an external device with a write function code to more convenient strings that are then stored in Fhem readings
          + or back (as reversed map) when a value to read has to be converted from the Fhem reading value to a raw value that can be sent back as response.
          + Example: 0:mittig, 1:oberhalb, 2:unterhalb
        • obj-[cdih][1-9][0-9]*-format
          • - defines a format string to format the value read e.g. %.1f -
          + In master mode this defines a format string (see Perl sprintf) to format a value read from an external slave device before it is stored in a reading e.g. %.1f
          + In slave mode this defines a format string to format a value from a Fhem reading before it is sent back in a response to an external master
        • obj-[cdih][1-9][0-9]*-len
          • - defines the length of the data object in registers. It defaults to 1. - Some devices store 32 bit floating point values in two registers. In this case you should set this attribute to two. -
          + defines the length of the data object in registers. It defaults to 1.
          + Some devices store e.g. 32 bit floating point values in two registers. In this case you should set this attribute to two.
          + This setting is relevant both in master and in slave mode. The lenght has to match the length implied by the unpack code.
        • obj-[cdih][1-9][0-9]*-unpack
          • - defines the unpack code to convert the raw data string read from the device to a reading. - For an unsigned integer in big endian format this would be "n", - for a signed 16 bit integer in big endian format this would be "s>" - and for a 32 bit big endian float value this would be "f>". (see the perl documentation of the pack function).
          + defines the pack / unpack code to convert data types.
          + In master mode it converts the raw data string read from the external slave device to a reading or to convert from a reading to a raw format when a write request is sent to the external slave device.
          + In slave mode it converts the value of a reading in Fhem to a raw format that can be sent as a response to an external Modbus master or it converts the raw data string read from the external master device to a reading when the master is using a write function code and writing has been allowed.
          + For an unsigned integer in big endian format this would be "n",
          + for a signed 16 bit integer in big endian format this would be "s>", in little endian format it would be "s<"
          + and for a 32 bit big endian float value this would be e.g. "f>". (see the perl documentation of the pack function for more codes and details).
          Please note that you also have to set a -len attribute (for this object or for the device) if you specify an unpack code that consumes data from more than one register.
          - For a 32 bit float len should be at least 2. -
          + For a 32 bit float e.g. len should be 2.
        • obj-[cdih][1-9][0-9]*-revRegs
          • this is only applicable to objects that span several input registers or holding registers.
          - when they are read then the order of the registers will be reversed before - further interpretation / unpacking of the raw register string. The same happens before the object is written with a set command. -
          + When they are received from an external device then the order of the registers will be reversed before further interpretation / unpacking of the raw register string. The same happens before data is sent to an external device
        • obj-[cdih][1-9][0-9]*-bswapRegs
          • - this is applicable to objects that span several input or holding registers.
          - After the registers have been read and before they are writtem, all 16-bit values are treated big-endian and are reversed to little-endian by swapping the two 8 bit bytes. - This functionality is most likely used for reading (ASCII) strings from the device that are stored as big-endian 16-bit values.
          - example: original reading is "324d3130203a57577361657320722020". After applying bswapRegs, the value will be "4d3230313a2057576173736572202020" - which will result in the ASCII string "M201: WWasser ". Should be used with "(a*)" as -unpack value. -
          + After registers have been received and before they are sent, the byte order of all 16-bit values are swapped. This changes big-endian to little-endian or vice versa. This functionality is most likely used for reading (ASCII) strings from devices where they are stored as big-endian 16-bit values.
          + Example: original reading is "324d3130203a57577361657320722020". After applying bswapRegs, the value will be "4d3230313a2057576173736572202020" + which will result in the ASCII string "M201: WWasser ". Should be used with "(a*)" as -unpack value.
        • obj-[cdih][1-9][0-9]*-decode
          • - defines an encoding to be used in a call to the perl function decode to convert the raw data string read from the device to a reading. - This can be used if the device delivers strings in an encoding like cp850 instead of utf8. -
          + defines an encoding to be used in a call to the perl function decode to convert the raw data string received from a device. + This can be used if the device delivers strings in an encoding like cp850 instead of utf8.
        • obj-[cdih][1-9][0-9]*-encode
          • - defines an encoding to be used in a call to the perl function encode to convert the raw data string read from the device to a reading. - This can be used if the device delivers strings in an encoding like cp850 and after decoding it you want to reencode it to e.g. utf8. -
          + defines an encoding to be used in a call to the perl function encode to convert raw data strings received from a device. + This can be used if the device delivers strings in an encoding like cp850 and after decoding it you want to reencode it to e.g. utf8.
        • obj-[ih][1-9][0-9]*-type
          • defines that this object has a user defined data type. Data types can be defined using the dev-type- attribues.
          If a device with many objects uses for example floating point values that span two swapped registers with the unpack code f>, then instead of specifying the -unpack, -revRegs, -len, -format and other attributes over and over again, you could define a data type with attributes that start with dev-type-VT_R4- and then @@ -328,101 +535,97 @@ ModbusAttr_Initialize($) attr WP obj-h1234-reading Temp_Ist attr WP obj-h1234-type VT_R4 - -
          +
        • obj-[cdih][1-9][0-9]*-showGet
          • - every reading can also be requested by a get command. However these get commands are not automatically offered in fhemweb. - By specifying this attribute, the get will be visible in fhemweb. -
          + If the Fhem Modbus device is in master mode, every reading can also be requested by a get command. However these get commands are not automatically offered in fhemweb. By specifying this attribute, the get will be visible in fhemweb.
        • obj-[cdih][1-9][0-9]*-poll
          • - if set to 1 then this obeject is included in the cyclic update request as specified in the define command. + If the Fhem Modbus device is in master mode, Fhem automatically creates read requests to the external modbus slave. + If this attribute is set to 1 for an object then this obeject is included in the cyclic update request as specified in the define command for a Modbus master. If not set, then the object can manually be requested with a get command, but it is not automatically updated each interval. - Note that this setting can also be specified as default for all objects with the dev- atributes described later. -
          + Note that this setting can also be specified as default for all objects with the dev- atributes described later.
          + This attribute is ignored in slave mode.
        • obj-[cdih][1-9][0-9]*-polldelay
          • - this attribute allows to poll objects at a lower rate than the interval specified in the define command. + this applies only to master mode. It allows to poll objects at a lower rate than the interval specified in the define command. You can either specify a time in seconds or number prefixed by "x" which means a multiple of the interval of the define command.
          - If you specify a normal numer then it is interpreted as minimal time between the last read and another automatic read. + If you specify a normal numer then it is interpreted as minimal time between the last read and another automatic read.
          Please note that this does not create an additional interval timer. Instead the normal interval timer defined by the interval of the define command will check if this reading is due or not yet. - So the effective interval will always be a multiple of the interval of the define. -
          -
          + So the effective interval will always be a multiple of the interval of the define.
          +
          +
        • dev-([cdih]-)*read
          • - specifies the function code to use for reading this type of object. - The default is 3 for holding registers, 1 for coils, 2 for discrete inputs and 4 for input registers. -
          + specifies the function code to use for reading this type of object in master mode. + The default is 3 for holding registers, 1 for coils, 2 for discrete inputs and 4 for input registers.
        • dev-([cdih]-)*write
          • - specifies the function code to use for writing this type of object. - The default is 6 for holding registers and 5 for coils. Discrete inputs and input registers can not be written by definition. -
          + specifies the function code (decimal) to use for writing this type of object in master mode. + The default is 6 for holding registers and 5 for coils. Discrete inputs and input registers can not be written by definition.
          + Some slave devices might need function code 16 for writing holding registers. In this case dev-h-write can be set to 16.
        • dev-([cdih]-)*combine
          • - defines how many adjacent objects can be read in one request. If not specified, the default is 1 -
          + This applies only to master mode. It defines how many adjacent objects of an external slave device can be read in one request. If not specified, the default is 1
          + +
        • dev-([cdih]-)*addressErrCode
          • + This applies only if the Fhem Modbus device is in slave mode. + defines which error code to send back to a master that requests an object with an address that is not configured in Fhem.
          + If nothing is specified, the error code 2 is used. If 0 is specified, then no error is sent back.
          +
        • dev-([cdih]-)*valueErrCode
          • + This applies only if the Fhem Modbus device is in slave mode. + It defines which error code to send back to a master that tries to write a value to an object / reading where the value is lower than the specified minimum value or higher than the specified maximum value. (this feature is not implemented yet)
          + If nothing is specified, the error code 1 is used. If 0 is specified, then no error is sent back.
          +
        • dev-([cdih]-)*notAllowedErrCode
          • + This applies only if the Fhem Modbus device is in slave mode. + It defines which error code to send back to a master that tries to write to an object / reading where writing has not been allowed with the .
          + If nothing is specified, the error code 1 is used. If 0 is specified, then no error is sent back.
          +
        • dev-([cdih]-)*defLen
          • - defines the default length for this object type. If not specified, the default is 1 -
          + defines the default length for this object type. If not specified, the default is 1
        • dev-([cdih]-)*defFormat
          • - defines a default format string to use for this object type in a sprintf function on the values read from the device. -
          + defines a default format string to use for this object type in a sprintf function on the values read from the device.
        • dev-([cdih]-)*defExpr
          • - defines a default Perl expression to use for this object type to convert raw values read. -
          + defines a default Perl expression to use for this object type to convert raw values read. (see obj-...-expr)
          +
        • dev-([cdih]-)*defSetexpr
          • + defines a default Perl expression to use like -setexpr (see obj-...-setexpr)
          +
        • dev-[cdih][1-9][0-9]*-defAllowWrite
          • + this only applies to a Fhem Modbus device in slave mode.
          + If set to 1 it defines that readings can be changed with a write function code by an external modbus master.
          +
        • dev-([cdih]-)*defIgnoreExpr
          • - defines a default Perl expression to decide when values should be ignored. -
          + defines a default Perl expression to decide when values should be ignored.
        • dev-([cdih]-)*defUnpack
          • - defines the default unpack code for this object type. -
          + defines the default unpack code for this object type.
        • dev-([cdih]-)*defRevRegs
          • defines that the order of registers for objects that span several registers will be reversed before - further interpretation / unpacking of the raw register string -
          + further interpretation / unpacking of the raw register string
        • dev-([cdih]-)*defBswapRegs
          • - per device default for swapping the bytes in Registers (see obj-bswapRegs above) -
          + per device default for swapping the bytes in Registers (see obj-bswapRegs above)
        • dev-([cdih]-)*defDecode
          • - defines a default for decoding the strings read from a different character set e.g. cp850 -
          + defines a default for decoding the strings read from a different character set e.g. cp850
        • dev-([cdih]-)*defEncode
          • - defines a default for encoding the strings read (or after decoding from a different character set) e.g. utf8 -
          - + defines a default for encoding the strings read (or after decoding from a different character set) e.g. utf8
        • dev-([cdih]-)*defPoll
          • - if set to 1 then all objects of this type will be included in the cyclic update by default. -
          + if set to 1 then all objects of this type will be included in the cyclic update by default.
        • dev-([cdih]-)*defShowGet
          • - if set to 1 then all objects of this type will have a visible get by default. -
          - + if set to 1 then all objects of this type will have a visible get by default.
        • dev-type-XYZ-unpack, -len, -encode, -decode, -revRegs, -bswapRegs, -format, -expr, -map
          • define the unpack code, length and other details of a user defined data type. XYZ has to be replaced with the name of a user defined data type. - use obj-h123-type XYZ to assign this type to an object. -
          - + use obj-h123-type XYZ to assign this type to an object.
        • dev-([cdih]-)*allowShortResponses
          • - if set to 1 the module will accept a response with valid checksum but data lengh < lengh in header -
          + if set to 1 the module will accept a response with valid checksum but data lengh < lengh in header
        • dev-h-brokenFC3
          • if set to 1 the module will change the parsing of function code 3 and 4 responses for devices that - send the register address instead of the length in the response -
          + send the register address instead of the length in the response
        • dev-c-brokenFC5
          • - if set the module will use the hex value specified here instead of ff00 as value 1 for setting coils -
          + if set the module will use the hex value specified here instead of ff00 as value 1 for setting coils
        • dev-timing-timeout
          • - timeout for the device (defaults to 2 seconds) -
          + timeout for the device (defaults to 2 seconds)
        • dev-timing-sendDelay
          • - delay to enforce between sending two requests to the device. Default ist 0.1 seconds. -
          + delay to enforce between sending two requests to the device. Default ist 0.1 seconds.
        • dev-timing-commDelay
          • - delay between the last read and a next request. Default ist 0.1 seconds. -
          -
        • queueMax
          • - max length of the send queue, defaults to 100 -
          + delay between the last read and a next request. Default ist 0.1 seconds.
          +
        • queueMax
          • + max length of the queue for sending modbus requests as master, defaults to 200.
          + This atribute should be used with devices connected through TCP or on physical + devices that are connected via serial lines but not on logical modbus devices that use another physical device as IODev.
        • nextOpenDelay
          • delay for Modbus-TCP connections. This defines how long the module should wait after a failed TCP connection attempt before the next reconnection attempt. This defaults to 60 seconds.
        • openTimeout
          • @@ -445,5 +648,6 @@ ModbusAttr_Initialize($)
        + =end html =cut