From cad5d3506fbf147d5643ffc6a26c0ce253437399 Mon Sep 17 00:00:00 2001 From: charlie71born <> Date: Wed, 14 Dec 2016 18:09:08 +0000 Subject: [PATCH] 44_S7: Siemens S5 is now supported (via serial interface) git-svn-id: https://svn.fhem.de/fhem/trunk@12776 2b470e98-0d58-463d-a4d8-8e2adae1ed80 --- fhem/FHEM/44_S7.pm | 1859 ++++++++++++++++++++++++++++++----- fhem/FHEM/44_S7_ARead.pm | 160 +-- fhem/FHEM/44_S7_AWrite.pm | 224 +++-- fhem/FHEM/44_S7_Client.pm | 1363 +------------------------ fhem/FHEM/44_S7_DRead.pm | 76 +- fhem/FHEM/44_S7_DWrite.pm | 531 +++++----- fhem/FHEM/44_S7_S5Client.pm | 840 ++++++++++++++++ fhem/FHEM/44_S7_S7Client.pm | 1337 +++++++++++++++++++++++++ 8 files changed, 4323 insertions(+), 2067 deletions(-) create mode 100644 fhem/FHEM/44_S7_S5Client.pm create mode 100644 fhem/FHEM/44_S7_S7Client.pm diff --git a/fhem/FHEM/44_S7.pm b/fhem/FHEM/44_S7.pm index 1017b98f3..47ce2d895 100644 --- a/fhem/FHEM/44_S7.pm +++ b/fhem/FHEM/44_S7.pm @@ -5,16 +5,21 @@ package main; use strict; use warnings; + #use Devel::NYTProf; #profiler - -require "44_S7_Client.pm"; +require "44_S7_S7Client.pm"; +require "44_S7_S5Client.pm"; my %gets = ( "S7TCPClientVersion" => "", "PLCTime" => "" ); +my %sets = ( + "intervall" => "" +); + my @areasconfig = ( "ReadInputs-Config", "ReadOutputs-Config", "ReadFlags-Config", "ReadDB-Config", @@ -22,15 +27,16 @@ my @areasconfig = ( "WriteFlags-Config", "WriteDB-Config" ); my @s7areas = ( - &S7Client::S7AreaPE, &S7Client::S7AreaPA, &S7Client::S7AreaMK, - &S7Client::S7AreaDB, &S7Client::S7AreaPE, &S7Client::S7AreaPA, - &S7Client::S7AreaMK, &S7Client::S7AreaDB + &S7ClientBase::S7AreaPE, &S7ClientBase::S7AreaPA, &S7ClientBase::S7AreaMK, + &S7ClientBase::S7AreaDB, &S7ClientBase::S7AreaPE, &S7ClientBase::S7AreaPA, + &S7ClientBase::S7AreaMK, &S7ClientBase::S7AreaDB ); my @areaname = ( "inputs", "outputs", "flags", "db", "inputs", "outputs", "flags", "db" ); ##################################### -sub S7_Initialize($) { +sub S7_Initialize($) { #S5_OK + my $hash = shift @_; # Provider @@ -48,8 +54,10 @@ sub S7_Initialize($) { $hash->{DefFn} = "S7_Define"; $hash->{UndefFn} = "S7_Undef"; $hash->{GetFn} = "S7_Get"; + $hash->{SetFn} = "S7_Set"; + $hash->{AttrFn} = "S7_Attr"; - $hash->{AttrList} = "MaxMessageLength " . $readingFnAttributes; + $hash->{AttrList} = "MaxMessageLength Intervall " . $readingFnAttributes; # $hash->{AttrList} = join( " ", @areasconfig )." PLCTime"; } @@ -61,103 +69,137 @@ sub S7_connect($) { my $name = $hash->{NAME}; if ( $hash->{STATE} eq "connected to PLC" ) { - Log3 $name, 2, "$name S7_connect: allready connected!"; + Log3( $name, 2, "$name S7_connect: allready connected!" ); return; } - Log3 $name, 4, - "S7: $name connect ip_address=" - . $hash->{ipAddress} - . ", LocalTSAP=" - . $hash->{LocalTSAP} - . ", RemoteTSAP=" - . $hash->{RemoteTSAP} . " "; + Log3( $name, 4, + "S7: $name connect PLC_address=" + . $hash->{plcAddress} + . ", LocalTSAP=" + . $hash->{LocalTSAP} + . ", RemoteTSAP=" + . $hash->{RemoteTSAP} + . " " ); - - if ( !defined( $hash->{S7TCPClient} ) ) { + if ( !defined( $hash->{S7PLCClient} ) ) { S7_reconnect($hash); return; } - $hash->{STATE} = "disconnected"; main::readingsSingleUpdate( $hash, "state", "disconnected", 1 ); - - $hash->{S7TCPClient} - ->SetConnectionParams( $hash->{ipAddress}, $hash->{LocalTSAP}, - $hash->{RemoteTSAP} ); - my $res; - eval { - local $SIG{__DIE__} = sub { - my ($s) = @_; - Log3 $hash, 0, "S7_connect: $s"; - $res = -1; + + if ( $hash->{S7TYPE} eq "S5" ) { + eval { + local $SIG{__DIE__} = sub { + my ($s) = @_; + Log3( $hash, 0, "S7_connect: $s" ); + $res = -1; + }; + $res = + $hash->{S7PLCClient}->S5ConnectPLCAS511( $hash->{plcAddress} ); }; - $res = $hash->{S7TCPClient}->Connect(); - }; + } + else { + $hash->{S7PLCClient} + ->SetConnectionParams( $hash->{plcAddress}, $hash->{LocalTSAP}, + $hash->{RemoteTSAP} ); + + eval { + local $SIG{__DIE__} = sub { + my ($s) = @_; + Log3( $hash, 0, "S7_connect: $s" ); + $res = -1; + }; + $res = $hash->{S7PLCClient}->Connect(); + }; + } if ($res) { - Log3 $name, 2, "S7_connect: $name Could not connect to PLC ($res)"; + Log3( $name, 2, "S7_connect: $name Could not connect to PLC ($res)" ); return; } - my $PDUlength = $hash->{S7TCPClient}->{PDULength}; + my $PDUlength = $hash->{S7PLCClient}->{PDULength}; $hash->{maxPDUlength} = $PDUlength; - Log3 $name, 3, - "$name S7_connect: connect to PLC with maxPDUlength=$PDUlength"; + Log3( $name, 3, + "$name S7_connect: connect to PLC with maxPDUlength=$PDUlength" ); $hash->{STATE} = "connected to PLC"; main::readingsSingleUpdate( $hash, "state", "connected to PLC", 1 ); - return undef; } ##################################### -sub S7_disconnect($) { +sub S7_disconnect($) { #S5 OK my $hash = shift @_; - my ( $ph, $res, $di); + my ( $ph, $res, $di ); my $name = $hash->{NAME}; my $error = ""; - $hash->{S7TCPClient}->Disconnect() if ( defined( $hash->{S7TCPClient} ) ); - $hash->{S7TCPClient} = undef; #TCP Client freigeben + $hash->{S7PLCClient}->Disconnect() if ( defined( $hash->{S7PLCClient} ) ); + $hash->{S7PLCClient} = undef; #PLC Client freigeben $hash->{STATE} = "disconnected"; main::readingsSingleUpdate( $hash, "state", "disconnected", 1 ); - Log3 $name, 2, "$name S7 disconnected"; + Log3( $name, 2, "$name S7 disconnected" ); } ##################################### -sub S7_reconnect($) { +sub S7_reconnect($) { #S5 OK my $hash = shift @_; - S7_disconnect($hash) if ( defined( $hash->{S7TCPClient} ) ); + S7_disconnect($hash) if ( defined( $hash->{S7PLCClient} ) ); - $hash->{S7TCPClient} = S7Client->new(); + if ( $hash->{S7TYPE} eq "S5" ) { + $hash->{S7PLCClient} = S5Client->new(); + } + else { + $hash->{S7PLCClient} = S7Client->new(); + } InternalTimer( gettimeofday() + 3, "S7_connect", $hash, 1 ) - ; #wait 3 seconds for reconnect + ; #wait 3 seconds for reconnect } ##################################### -sub S7_Define($$) { +sub S7_Define($$) { # S5 OK my ( $hash, $def ) = @_; my @a = split( "[ \t][ \t]*", $def ); - my ( $name, $ip_address, $LocalTSAP, $RemoteTSAP, $res, $PDUlength, $rack, + my ( $name, $PLC_address, $LocalTSAP, $RemoteTSAP, $res, $PDUlength, $rack, $slot ); $name = $a[0]; - if ( uc $a[2] eq "LOGO7" || uc $a[2] eq "LOGO8" ) { - $ip_address = $a[3]; + if ( uc $a[2] eq "S5" ) { + $hash->{S7TYPE} = "S5"; + $PLC_address = $a[3]; + if (@a > 4) { + $hash->{Interval} = $a[4]; + } else { + $hash->{Interval} = 1; + } + $LocalTSAP = -1; + $RemoteTSAP = -1; + + $PDUlength = 240; + + } + elsif ( uc $a[2] eq "LOGO7" || uc $a[2] eq "LOGO8" ) { + $PLC_address = $a[3]; $LocalTSAP = 0x0100; $RemoteTSAP = 0x0200; - $hash->{Interval} = 1; + if (@a > 4) { + $hash->{Interval} = $a[4]; + } else { + $hash->{Interval} = 1; + } if ( uc $a[2] eq "LOGO7" ) { $hash->{S7TYPE} = "LOGO7"; } @@ -169,7 +211,7 @@ sub S7_Define($$) { } else { - $ip_address = $a[2]; + $PLC_address = $a[2]; $rack = int( $a[3] ); return "invalid rack parameter (0 - 15)" @@ -193,13 +235,13 @@ sub S7_Define($$) { $hash->{S7TYPE} = "NATIVE"; } - $hash->{ipAddress} = $ip_address; - $hash->{LocalTSAP} = $LocalTSAP; - $hash->{RemoteTSAP} = $RemoteTSAP; - $hash->{maxPDUlength} = $PDUlength; #initial PDU length + $hash->{plcAddress} = $PLC_address; + $hash->{LocalTSAP} = $LocalTSAP; + $hash->{RemoteTSAP} = $RemoteTSAP; + $hash->{maxPDUlength} = $PDUlength; #initial PDU length Log3 $name, 4, -"S7: define $name ip_address=$ip_address,LocalTSAP=$LocalTSAP, RemoteTSAP=$RemoteTSAP "; +"S7: define $name PLC_address=$PLC_address,LocalTSAP=$LocalTSAP, RemoteTSAP=$RemoteTSAP "; $hash->{STATE} = "disconnected"; main::readingsSingleUpdate( $hash, "state", "disconnected", 1 ); @@ -213,7 +255,7 @@ sub S7_Define($$) { } ##################################### -sub S7_Undef($) { +sub S7_Undef($) { #S5 OK my $hash = shift; RemoveInternalTimer($hash); @@ -225,8 +267,16 @@ sub S7_Undef($) { return undef; } + ##################################### -sub S7_Get($@) { +sub S7_Set($@) { + + +} + + +##################################### +sub S7_Get($@) { #S5 OK my ( $hash, @a ) = @_; return "Need at least one parameters" if ( @a < 2 ); return "Unknown argument $a[1], choose one of " @@ -238,11 +288,11 @@ sub S7_Get($@) { ARGUMENT_HANDLER: { $cmd eq "S7TCPClientVersion" and do { - return $hash->{S7TCPClient}->version(); + return $hash->{S7PLCClient}->version(); last; }; $cmd eq "PLCTime" and do { - return $hash->{S7TCPClient}->getPLCDateTime(); + return $hash->{S7PLCClient}->getPLCDateTime(); last; }; } @@ -262,12 +312,19 @@ sub S7_Attr(@) { if ( $cmd eq "set" ) { if ( $aName eq "MaxMessageLength" ) { - if ( $aVal < $hash->{S7TCPClient}->{MaxReadLength} ) { + if ( $aVal < $hash->{S7PLCClient}->{MaxReadLength} ) { - $hash->{S7TCPClient}->{MaxReadLength} = $aVal; + $hash->{S7PLCClient}->{MaxReadLength} = $aVal; - Log3 $name, 3, "$name S7_Attr: setting MaxReadLength= $aVal"; + Log3( $name, 3, "$name S7_Attr: setting MaxReadLength= $aVal" ); } + } elsif ($aName eq "MaxMessageLength") { + if ( $aVal >= 1 ) { + + $hash->{Interval} = $aVal; + + Log3( $name, 3, "$name S7_Attr: setting Intervall= $aVal" ); + } } ########### @@ -277,11 +334,11 @@ sub S7_Attr(@) { || $aName eq "WriteDB-Config" ) { my $PDUlength = $hash->{maxPDUlength}; - + my @a = split( "[ \t][ \t]*", $aVal ); if ( int(@a) % 3 != 0 || int(@a) == 0 ) { - Log3 $name, 3, - "S7: Invalid $aName in attr $name $aName $aVal: $@"; + Log3( $name, 3, + "S7: Invalid $aName in attr $name $aName $aVal: $@" ); return "Invalid $aName $aVal \n Format: [ ]"; } @@ -290,20 +347,22 @@ sub S7_Attr(@) { for ( my $i = 0 ; $i < int(@a) ; $i++ ) { if ( $a[$i] ne int( $a[$i] ) ) { my $s = $a[$i]; - Log3 $name, 3, -"S7: Invalid $aName in attr $name $aName $aVal ($s is not a number): $@"; + Log3( $name, 3, +"S7: Invalid $aName in attr $name $aName $aVal ($s is not a number): $@" + ); return "Invalid $aName $aVal: $s is not a number"; } if ( $i % 3 == 0 && ( $a[$i] < 0 || $a[$i] > 1024 ) ) { - Log3 $name, 3, - "S7: Invalid $aName db. valid db 0 - 1024: $@"; + Log3( $name, 3, + "S7: Invalid $aName db. valid db 0 - 1024: $@" ); return "Invalid $aName length: $aVal db: valid db 0 - 1024"; } if ( $i % 3 == 1 && ( $a[$i] < 0 || $a[$i] > 32768 ) ) { - Log3 $name, 3, -"S7: Invalid $aName startposition. valid startposition 0 - 32768: $@"; + Log3( $name, 3, +"S7: Invalid $aName startposition. valid startposition 0 - 32768: $@" + ); return "Invalid $aName startposition: $aVal db: valid startposition 0 - 32768"; @@ -311,8 +370,9 @@ sub S7_Attr(@) { if ( $i % 3 == 2 && ( $a[$i] < 1 || $a[$i] > $PDUlength ) ) { - Log3 $name, 3, -"S7: Invalid $aName length. valid length 1 - $PDUlength: $@"; + Log3( $name, 3, +"S7: Invalid $aName length. valid length 1 - $PDUlength: $@" + ); return "Invalid $aName lenght: $aVal: valid length 1 - $PDUlength"; } @@ -340,7 +400,7 @@ sub S7_Attr(@) { ##################################### -sub S7_getAreaIndex4AreaName($) { +sub S7_getAreaIndex4AreaName($) { #S5 OK my ($aName) = @_; my $AreaIndex = -1; @@ -351,7 +411,7 @@ sub S7_getAreaIndex4AreaName($) { } } if ( $AreaIndex < 0 ) { - Log3 undef, 2, "S7_Attr: Internal error invalid WriteAreaIndex"; + Log3( undef, 2, "S7_Attr: Internal error invalid WriteAreaIndex" ); return "Internal error invalid WriteAreaIndex"; } return $AreaIndex; @@ -369,35 +429,44 @@ sub S7_WriteToPLC($$$$$$) { my $name = $hash->{NAME}; my $res = -1; - my $Bufferlength = length($dataBlock); + my $Bufferlength = 59999; + $Bufferlength = length($dataBlock); if ( $Bufferlength <= $PDUlength ) { if ( $hash->{STATE} eq "connected to PLC" ) { my $bss = join( ", ", unpack( "H2" x $Bufferlength, $dataBlock ) ); - Log3 $name, 5, -"$name S7_WriteToPLC: Write Bytes to PLC: $areaIndex, $dbNr,$startByte , $Bufferlength, $bss"; - + Log3( $name, 5, +"$name S7_WriteToPLC: Write Bytes to PLC: $areaIndex, $dbNr,$startByte , $Bufferlength, $bss" + ); eval { local $SIG{__DIE__} = sub { my ($s) = @_; print "DIE:$s"; - Log3 $hash, 0, "DIE:$s"; + Log3( $hash, 0, "DIE:$s" ); $res = -2; }; - $res = - $hash->{S7TCPClient} - ->WriteArea( $s7areas[$areaIndex], $dbNr, $startByte, - $Bufferlength, $WordLen, $dataBlock ); + if ( $hash->{S7TYPE} eq "S5" ) { + $res = $hash->{S7PLCClient}->S5WriteS5Bytes( + $s7areas[$areaIndex], $dbNr, $startByte, $Bufferlength, + $dataBlock + ); + } + else { + $res = + $hash->{S7PLCClient} + ->WriteArea( $s7areas[$areaIndex], $dbNr, $startByte, + $Bufferlength, $WordLen, $dataBlock ); + } }; if ( $res != 0 ) { - my $error = $hash->{S7TCPClient}->getErrorStr($res); + my $error = $hash->{S7PLCClient}->getErrorStr($res); my $msg = "$name S7_WriteToPLC WriteArea error: $res=$error"; - Log3 $name, 3, $msg; + Log3( $name, 3, $msg ); S7_reconnect($hash); #lets try a reconnect return ( -2, $msg ); @@ -406,7 +475,7 @@ sub S7_WriteToPLC($$$$$$) { else { my $msg = "$name S7_WriteToPLC: PLC is not connected "; - Log3 $name, 3, $msg; + Log3( $name, 3, $msg ); S7_reconnect($hash); #lets try a reconnect @@ -417,7 +486,7 @@ sub S7_WriteToPLC($$$$$$) { else { my $msg = "S7_WriteToPLC: wrong block length $Bufferlength (max length $PDUlength)"; - Log3 $name, 3, $msg; + Log3( $name, 3, $msg ); return ( -1, $msg ); } } @@ -438,10 +507,9 @@ sub S7_WriteBitToPLC($$$$$) { if ( $hash->{STATE} eq "connected to PLC" ) { my $bss = join( ", ", unpack( "H2" x $Bufferlength, $bitValue ) ); - Log3 $name, 5, -"$name S7_WriteBitToPLC: Write Bytes to PLC: $areaIndex, $dbNr, $bitPosition , $Bufferlength, $bitValue"; - - + Log3( $name, 5, +"$name S7_WriteBitToPLC: Write Bytes to PLC: $areaIndex, $dbNr, $bitPosition , $Bufferlength, $bitValue" + ); eval { local $SIG{__DIE__} = sub { @@ -451,15 +519,19 @@ sub S7_WriteBitToPLC($$$$$) { $res = -2; }; - $res = - $hash->{S7TCPClient} - ->WriteArea( $s7areas[$areaIndex], $dbNr, $bitPosition, - $Bufferlength, &S7Client::S7WLBit, chr($bitValue) ); - + if ( $hash->{S7TYPE} eq "S5" ) { + #todo fix S5 Handling + } + else { + $res = + $hash->{S7PLCClient} + ->WriteArea( $s7areas[$areaIndex], $dbNr, $bitPosition, + $Bufferlength, &S7Client::S7WLBit, chr($bitValue) ); + } }; if ( $res != 0 ) { - my $error = $hash->{S7TCPClient}->getErrorStr($res); + my $error = $hash->{S7PLCClient}->getErrorStr($res); my $msg = "$name S7_WriteBitToPLC WriteArea error: $res=$error"; Log3 $name, 3, $msg; @@ -515,18 +587,26 @@ sub S7_ReadBlockFromPLC($$$$$) { $res = -2; }; - ( $res, $readbuffer ) = - $hash->{S7TCPClient}->ReadArea( $s7areas[$areaIndex], $dbNr, $startByte, - $requestedLength, &S7Client::S7WLByte ); + if ( $hash->{S7TYPE} eq "S5" ) { + ( $res, $readbuffer ) = + $hash->{S7PLCClient} + ->S5ReadS5Bytes( $s7areas[$areaIndex], $dbNr, $startByte, + $requestedLength ); + } + else { + ( $res, $readbuffer ) = + $hash->{S7PLCClient} + ->ReadArea( $s7areas[$areaIndex], $dbNr, $startByte, + $requestedLength, &S7Client::S7WLByte ); + } }; - if ( $res != 0 ) { - my $error = $hash->{S7TCPClient}->getErrorStr($res); + my $error = $hash->{S7PLCClient}->getErrorStr($res); my $msg = "$name S7_ReadBlockFromPLC ReadArea error: $res=$error"; - Log3 $name, 3, $msg; + Log3( $name, 3, $msg ); S7_reconnect($hash); #lets try a reconnect return ( -2, $msg ); @@ -539,7 +619,7 @@ sub S7_ReadBlockFromPLC($$$$$) { } else { my $msg = "$name S7_ReadBlockFromPLC: PLC is not connected "; - Log3 $name, 3, $msg; + Log3( $name, 3, $msg ); return ( -1, $msg ); } @@ -547,14 +627,14 @@ sub S7_ReadBlockFromPLC($$$$$) { else { my $msg = "$name S7_ReadBlockFromPLC: wrong block length (max length $PDUlength)"; - Log3 $name, 3, $msg; + Log3( $name, 3, $msg ); return ( -1, $msg ); } } ##################################### -sub S7_setBitInBuffer($$$) { +sub S7_setBitInBuffer($$$) { #S5 OK my ( $bitPosition, $buffer, $newValue ) = @_; my $Bufferlength = ( length($buffer) + 1 ) / 3; @@ -573,7 +653,6 @@ sub S7_setBitInBuffer($$$) { my @Writebuffer = unpack( "C" x $Bufferlength, pack( "H2" x $Bufferlength, split( ",", $buffer ) ) ); - #my $intrestingByte = $Writebuffer[$bytePosition]; my $intrestingBit = $bitPosition % 8; if ( $newValue eq "on" || $newValue eq "trigger" ) { @@ -599,7 +678,7 @@ sub S7_setBitInBuffer($$$) { } ##################################### -sub S7_getBitFromBuffer($$) { +sub S7_getBitFromBuffer($$) { #S5 OK my ( $bitPosition, $buffer ) = @_; my $Bufferlength = ( length($buffer) * 3 ) - 1; @@ -626,7 +705,7 @@ sub S7_getBitFromBuffer($$) { } ##################################### -sub S7_getAllWritingBuffersFromPLC($$$) { +sub S7_getAllWritingBuffersFromPLC($$$) { #S5 OK #$hash ... from S7 physical modul #$writerConfig ... writer Config @@ -634,7 +713,7 @@ sub S7_getAllWritingBuffersFromPLC($$$) { my ( $hash, $aName, $writerConfig ) = @_; - Log3 $aName, 4, "S7: getAllWritingBuffersFromPLC called"; + Log3( $aName, 4, "S7: getAllWritingBuffersFromPLC called" ); my @a = split( "[ \t][ \t]*", $writerConfig ); @@ -688,7 +767,7 @@ sub S7_getAllWritingBuffersFromPLC($$$) { sub S7_GetUpdate($) { my ($hash) = @_; my $name = $hash->{NAME}; - Log3 $name, 4, "S7: $name GetUpdate called ..."; + Log3( $name, 4, "S7: $name GetUpdate called ..." ); my $res = S7_readFromPLC($hash); @@ -706,9 +785,11 @@ sub S7_GetUpdate($) { ##################################### sub S7_dispatchMsg($$$$$$$$) { - my ( $hash, $msgprefix, $areaIndex, $dbNr, $startByte, $hexbuffer,$length, $clientsNames ) = @_; + my ( $hash, $msgprefix, $areaIndex, $dbNr, $startByte, $hexbuffer, $length, + $clientsNames ) + = @_; - my $name = $hash->{NAME}; + my $name = $hash->{NAME}; my $dmsg = $msgprefix . " " . $areaname[$areaIndex] . " " @@ -716,39 +797,38 @@ sub S7_dispatchMsg($$$$$$$$) { . $startByte . " " . $length . " " . $name . " " - . $hexbuffer. " " - . $clientsNames - ; + . $hexbuffer . " " + . $clientsNames; - - Log3 $name, 5, $name . " S7_dispatchMsg " . $dmsg; + Log3( $name, 5, $name . " S7_dispatchMsg " . $dmsg ); Dispatch( $hash, $dmsg, {} ); } ##################################### -sub S7_readAndDispatchBlockFromPLC($$$$$$$$$$) { +sub S7_readAndDispatchBlockFromPLC($$$$$$$$$$) { #S5 OK my ( $hash, $area, $dbnr, $blockstartpos, $blocklength, $hasAnalogReading, - $hasDigitalReading, $hasAnalogWriting, $hasDigitalWriting, $clientsNames + $hasDigitalReading, $hasAnalogWriting, $hasDigitalWriting, + $clientsNames ) = @_; my $name = $hash->{NAME}; my $state = $hash->{STATE}; my $areaIndex = S7_getAreaIndex4AreaName($area); - - Log3 $name, 4, - $name - . " READ Block AREA=" - . $area - . ", DB =" - . $dbnr - . ", ADDRESS=" - . $blockstartpos - . ", LENGTH=" - . $blocklength; + Log3( $name, 4, + $name + . " READ Block AREA=" + . $area . " (" + . $areaIndex + . "), DB =" + . $dbnr + . ", ADDRESS=" + . $blockstartpos + . ", LENGTH=" + . $blocklength ); if ( $state ne "connected to PLC" ) { Log3 $name, 3, "$name is disconnected ? --> reconnect"; @@ -772,18 +852,18 @@ sub S7_readAndDispatchBlockFromPLC($$$$$$$$$$) { #dispatch to reader S7_dispatchMsg( $hash, "AR", $areaIndex, $dbnr, $blockstartpos, - $hexbuffer,$length,$clientsNames ) + $hexbuffer, $length, $clientsNames ) if ( $hasAnalogReading > 0 ); S7_dispatchMsg( $hash, "DR", $areaIndex, $dbnr, $blockstartpos, - $hexbuffer,$length,$clientsNames ) + $hexbuffer, $length, $clientsNames ) if ( $hasDigitalReading > 0 ); #dispatch to writer S7_dispatchMsg( $hash, "AW", $areaIndex, $dbnr, $blockstartpos, - $hexbuffer,$length,$clientsNames ) + $hexbuffer, $length, $clientsNames ) if ( $hasAnalogWriting > 0 ); S7_dispatchMsg( $hash, "DW", $areaIndex, $dbnr, $blockstartpos, - $hexbuffer,$length,$clientsNames ) + $hexbuffer, $length, $clientsNames ) if ( $hasDigitalWriting > 0 ); return 0; } @@ -795,7 +875,7 @@ sub S7_readAndDispatchBlockFromPLC($$$$$$$$$$) { } ##################################### -sub S7_getReadingsList($) { +sub S7_getReadingsList($) { #S5 OK my ($hash) = @_; my $name = $hash->{NAME}; @@ -808,7 +888,8 @@ sub S7_getReadingsList($) { @mykeys = grep $defs{$_}{TYPE} =~ /^S7_/ && $defs{$_}{IODev}{NAME} eq $hash->{NAME}, keys(%defs); - @logoClients{@mykeys} = @defs{@mykeys};#jetzt haben wir alle clients in logoClients + @logoClients{@mykeys} = + @defs{@mykeys}; #jetzt haben wir alle clients in logoClients #we need to find out the unique areas my %tmphash = map { $logoClients{$_}{AREA} => 1 } keys %logoClients; @@ -850,7 +931,7 @@ sub S7_getReadingsList($) { my $hasDigitalReading = 0; my $hasAnalogWriting = 0; my $hasDigitalWriting = 0; - my $clientsName = ""; + my $clientsName = ""; for ( my $i = 0 ; $i < int(@positioned) ; $i++ ) { if ( $blockstartpos < 0 ) { @@ -872,7 +953,7 @@ sub S7_getReadingsList($) { $hasDigitalWriting++ if ( $logoClientsDB{ $positioned[$i] }{TYPE} eq "S7_DWrite" ); - + $clientsName = $logoClientsDB{ $positioned[$i] }{NAME}; } @@ -881,7 +962,7 @@ sub S7_getReadingsList($) { if ( $logoClientsDB{ $positioned[$i] }{ADDRESS} + $logoClientsDB{ $positioned[$i] }{LENGTH} - $blockstartpos <= - $hash->{S7TCPClient}->{MaxReadLength} ) + $hash->{S7PLCClient}->{MaxReadLength} ) { #extend existing block @@ -907,11 +988,10 @@ sub S7_getReadingsList($) { $hasDigitalWriting++ if ( $logoClientsDB{ $positioned[$i] }{TYPE} eq "S7_DWrite" ); - - - + } - $clientsName .= "," .$logoClientsDB{ $positioned[$i] }{NAME}; + $clientsName .= + "," . $logoClientsDB{ $positioned[$i] }{NAME}; } else { @@ -957,8 +1037,8 @@ sub S7_getReadingsList($) { $hasDigitalWriting++ if ( $logoClientsDB{ $positioned[$i] }{TYPE} eq "S7_DWrite" ); - - $clientsName = $logoClientsDB{ $positioned[$i] }{NAME}; + + $clientsName = $logoClientsDB{ $positioned[$i] }{NAME}; } } @@ -994,7 +1074,7 @@ sub S7_getReadingsList($) { } ##################################### -sub S7_readFromPLC($) { +sub S7_readFromPLC($) { #S5 OK my ($hash) = @_; my $name = $hash->{NAME}; my $res; @@ -1009,9 +1089,9 @@ sub S7_readFromPLC($) { for ( my $i = 0 ; $i < int(@readingList) ; $i++ ) { my @readingSet = @{ $readingList[$i] }; $res = S7_readAndDispatchBlockFromPLC( - $hash, $readingSet[0], $readingSet[1], - $readingSet[2], $readingSet[3], $readingSet[4], - $readingSet[5], $readingSet[6], $readingSet[7], $readingSet[8] + $hash, $readingSet[0], $readingSet[1], $readingSet[2], + $readingSet[3], $readingSet[4], $readingSet[5], $readingSet[6], + $readingSet[7], $readingSet[8] ); return $res if ( $res != 0 ); @@ -1019,8 +1099,6 @@ sub S7_readFromPLC($) { return 0; } - - 1; =pod @@ -1029,55 +1107,73 @@ sub S7_readFromPLC($) {

S7

    - This module connects a SIEMENS PLC (Note: also SIEMENS Logo is supported). The TCP communication module is based on settimino (http://settimino.sourceforge.net) You can found a german wiki here: httl://www.fhemwiki.de/wiki/S7
    -
    - For the communication the following modules have been implemented: -
      -
    • S7 … sets up the communication channel to the PLC
      • -
    • S7_ARead … Is used for reading integer Values from the PLC
      • -
    • S7_AWrite … Is used for write integer Values to the PLC
      • -
    • S7_DRead … Is used for read bits
      • -
    • S7_DWrite … Is used for writing bits.
      • -
    -
    -
    - Reading work flow:
    -
    - The S7 module reads periodically the configured DB areas from the PLC and stores the data in an internal buffer. Then all reading client modules are informed. Each client module extracts his data and the corresponding readings are set. Writing work flow:
    -
    - At the S7 module you need to configure the PLC writing target. Also the S7 module holds a writing buffer. Which contains a master copy of the data needs to send.
    - (Note: after configuration of the writing area a copy from the PLC is read and used as initial fill-up of the writing buffer)
    - Note: The S7 module will send always the whole data block to the PLC. When data on the clients modules is set then the client module updates the internal writing buffer on the S7 module and triggers the writing to the PLC.
    -
    - Define +This module connects a SIEMENS PLC (Note: also SIEMENS Logo is supported). +The TCP communication module is based on settimino (http://settimino.sourceforge.net) -
      -
    • define <name> S7 <ip_address> <rack> <slot> [<Interval>]
      -
      - define logo S7 10.0.0.241 2 0 +You can found a german wiki here: httl://www.fhemwiki.de/wiki/S7 -
        -
      • ip_address … IP address of the PLC
        • -
      • rack … rack of the PLC
        • -
      • slot … slot of the PLC
        • -
      • Interval … Intervall how often the modul should check if a reading is required
        • -
      -
      - Note: For Siemens logo you should use a alternative (more simply configuration method):
      - define logo S7 LOGO7 10.0.0.241
      • -
    -
    -
    - Attr
    - The following attributes are supported:
    -
    -   -
      -
    • MaxMessageLength
      • -
      -
    • MaxMessageLength ... restricts the packet length if lower than the negioated PDULength. This could be used to increate the processing speed. 2 small packages may be smaler than one large package
      • -
    +

    +For the communication the following modules have been implemented: +
      +
    • S7 … sets up the communication channel to the PLC
      • +
    • S7_ARead … Is used for reading integer Values from the PLC
      • +
    • S7_AWrite … Is used for write integer Values to the PLC
      • +
    • S7_DRead … Is used for read bits
      • +
    • S7_DWrite … Is used for writing bits.
    +
    +
    +Reading work flow: +
    +
    + +The S7 module reads periodically the configured DB areas from the PLC and stores the data in an internal buffer. Then all reading client modules are informed. Each client module extracts his data and the corresponding readings are set. + + +Writing work flow: +
    +
    +At the S7 module you need to configure the PLC writing target. Also the S7 module holds a writing buffer. Which contains a master copy of the data needs to send. +
    +(Note: after configuration of the writing area a copy from the PLC is read and used as initial fill-up of the writing buffer) +
    +Note: The S7 module will send always the whole data block to the PLC. +When data on the clients modules is set then the client module updates the internal writing buffer on the S7 module and triggers the writing to the PLC. +
    +
    + + +Define +
      +define <name> S7 <PLC_address> <rack> <slot> [<Interval>]

      + +define logo S7 10.0.0.241 2 0
      + +
        +
      • PLC_address … IP address of the S7 PLC (For S5 see below)
        • +
      • rack … rack of the PLC
        • +
      • slot … slot of the PLC
        • +
      • Interval … Intervall how often the modul should check if a reading is required
        • +
      +
      +Note: For Siemens logo you should use a alternative (more simply configuration method):
      +define logo S7 LOGO7 10.0.0.241 +
    +
+
+Note: For Siemens S5 you must use a alternative (more simply configuration method):
+define logo S7 S5 /dev/tty1 + +in this case the PLC_address is the serial port number + + +

+Attr
+The following attributes are supported:
+
    +
  • MaxMessageLength
    • +
    +MaxMessageLength ... restricts the packet length if lower than the negioated PDULength. This could be used to increate the processing speed. 2 small packages may be smaler than one large package =end html @@ -1087,57 +1183,1328 @@ sub S7_readFromPLC($) {

    S7

      - This module connects a SIEMENS PLC (Note: also SIEMENS Logo is supported). The TCP communication module is based on settimino (http://settimino.sourceforge.net) You can found a german wiki here: httl://www.fhemwiki.de/wiki/S7
      -
      - For the communication the following modules have been implemented: -
        -
      • S7 … sets up the communication channel to the PLC
        • -
      • S7_ARead … Is used for reading integer Values from the PLC
        • -
      • S7_AWrite … Is used for write integer Values to the PLC
        • -
      • S7_DRead … Is used for read bits
        • -
      • S7_DWrite … Is used for writing bits.
        • -
      -
      -
      - Reading work flow:
      -
      - The S7 module reads periodically the configured DB areas from the PLC and stores the data in an internal buffer. Then all reading client modules are informed. Each client module extracts his data and the corresponding readings are set. Writing work flow:
      -
      - At the S7 module you need to configure the PLC writing target. Also the S7 module holds a writing buffer. Which contains a master copy of the data needs to send.
      - (Note: after configuration of the writing area a copy from the PLC is read and used as initial fill-up of the writing buffer)
      - Note: The S7 module will send always the whole data block to the PLC. When data on the clients modules is set then the client module updates the internal writing buffer on the S7 module and triggers the writing to the PLC.
      -
      - Define +This module connects a SIEMENS PLC (Note: also SIEMENS Logo is supported). +The TCP communication module is based on settimino (http://settimino.sourceforge.net) -
        -
      • define <name> S7 <ip_address> <rack> <slot> [<Interval>]
        -
        - define logo S7 10.0.0.241 2 0 +You can found a german wiki here: httl://www.fhemwiki.de/wiki/S7 -
          -
        • ip_address … IP address of the PLC
          • -
        • rack … rack of the PLC
          • -
        • slot … slot of the PLC
          • -
        • Interval … Intervall how often the modul should check if a reading is required
          • -
        -
        - Note: For Siemens logo you should use a alternative (more simply configuration method):
        - define logo S7 LOGO7 10.0.0.241
        • -
      -
      -
      - Attr
      - The following attributes are supported:
      -
      -   -
        -
      • MaxMessageLength
        • -
        -
      • MaxMessageLength ... restricts the packet length if lower than the negioated PDULength. This could be used to increate the processing speed. 2 small packages may be smaler than one large package
        • -
      +

      +For the communication the following modules have been implemented: +
        +
      • S7 … sets up the communication channel to the PLC
        • +
      • S7_ARead … Is used for reading integer Values from the PLC
        • +
      • S7_AWrite … Is used for write integer Values to the PLC
        • +
      • S7_DRead … Is used for read bits
        • +
      • S7_DWrite … Is used for writing bits.
        • +
      +
      +
      +Reading work flow: +
      +
      + +The S7 module reads periodically the configured DB areas from the PLC and stores the data in an internal buffer. Then all reading client modules are informed. Each client module extracts his data and the corresponding readings are set. + + +Writing work flow: +
      +
      +At the S7 module you need to configure the PLC writing target. Also the S7 module holds a writing buffer. Which contains a master copy of the data needs to send. +
      +(Note: after configuration of the writing area a copy from the PLC is read and used as initial fill-up of the writing buffer) +
      +Note: The S7 module will send always the whole data block to the PLC. +When data on the clients modules is set then the client module updates the internal writing buffer on the S7 module and triggers the writing to the PLC. +
      +
      + + +Define +
        +define <name> S7 <PLC_address> <rack> <slot> [<Interval>]

        + +define logo S7 10.0.0.241 2 0
        + +
          +
        • PLC_address … IP address of the S7 PLC (For S5 see below)
          • +
        • rack … rack of the PLC
          • +
        • slot … slot of the PLC
          • +
        • Interval … Intervall how often the modul should check if a reading is required
          • +
        +
        +Note: For Siemens logo you should use a alternative (more simply configuration method):
        +define logo S7 LOGO7 10.0.0.241 +
      +
    +
    +Note: For Siemens S5 you must use a alternative (more simply configuration method):
    +define logo S7 S5 /dev/tty1 + +in this case the PLC_address is the serial port number
- +

+Attr
+The following attributes are supported:
+
    +
  • MaxMessageLength
    • +
    +MaxMessageLength ... restricts the packet length if lower than the negioated PDULength. This could be used to increate the processing speed. 2 small packages may be smaler than one large package =end html_DE =cut + +package main; + +use strict; +use warnings; + +#use Devel::NYTProf; #profiler + +require "44_S7_S7Client.pm"; +require "44_S7_S5Client.pm"; + +my %gets = ( + "S7TCPClientVersion" => "", + "PLCTime" => "" +); + +my %sets = ( + "intervall" => "" +); + +my @areasconfig = ( + "ReadInputs-Config", "ReadOutputs-Config", + "ReadFlags-Config", "ReadDB-Config", + "WriteInputs-Config", "WriteOutputs-Config", + "WriteFlags-Config", "WriteDB-Config" +); +my @s7areas = ( + &S7ClientBase::S7AreaPE, &S7ClientBase::S7AreaPA, &S7ClientBase::S7AreaMK, + &S7ClientBase::S7AreaDB, &S7ClientBase::S7AreaPE, &S7ClientBase::S7AreaPA, + &S7ClientBase::S7AreaMK, &S7ClientBase::S7AreaDB +); +my @areaname = + ( "inputs", "outputs", "flags", "db", "inputs", "outputs", "flags", "db" ); + +##################################### +sub S7_Initialize($) { #S5_OK + + my $hash = shift @_; + + # Provider + $hash->{Clients} = ":S7_DRead:S7_ARead:S7_AWrite:S7_DWrite:"; + my %matchList = ( + "1:S7_DRead" => "^DR", + "2:S7_DWrite" => "^DW", + "3:S7_ARead" => "^AR", + "4:S7_AWrite" => "^AW" + ); + + $hash->{MatchList} = \%matchList; + + # Consumer + $hash->{DefFn} = "S7_Define"; + $hash->{UndefFn} = "S7_Undef"; + $hash->{GetFn} = "S7_Get"; + $hash->{SetFn} = "S7_Set"; + + $hash->{AttrFn} = "S7_Attr"; + $hash->{AttrList} = "MaxMessageLength Intervall " . $readingFnAttributes; + + # $hash->{AttrList} = join( " ", @areasconfig )." PLCTime"; +} + +##################################### +sub S7_connect($) { + my $hash = shift @_; + + my $name = $hash->{NAME}; + + if ( $hash->{STATE} eq "connected to PLC" ) { + Log3( $name, 2, "$name S7_connect: allready connected!" ); + return; + } + + Log3( $name, 4, + "S7: $name connect PLC_address=" + . $hash->{plcAddress} + . ", LocalTSAP=" + . $hash->{LocalTSAP} + . ", RemoteTSAP=" + . $hash->{RemoteTSAP} + . " " ); + + if ( !defined( $hash->{S7PLCClient} ) ) { + S7_reconnect($hash); + return; + } + + $hash->{STATE} = "disconnected"; + main::readingsSingleUpdate( $hash, "state", "disconnected", 1 ); + my $res; + + if ( $hash->{S7TYPE} eq "S5" ) { + eval { + local $SIG{__DIE__} = sub { + my ($s) = @_; + Log3( $hash, 0, "S7_connect: $s" ); + $res = -1; + }; + $res = + $hash->{S7PLCClient}->S5ConnectPLCAS511( $hash->{plcAddress} ); + }; + } + else { + $hash->{S7PLCClient} + ->SetConnectionParams( $hash->{plcAddress}, $hash->{LocalTSAP}, + $hash->{RemoteTSAP} ); + + eval { + local $SIG{__DIE__} = sub { + my ($s) = @_; + Log3( $hash, 0, "S7_connect: $s" ); + $res = -1; + }; + $res = $hash->{S7PLCClient}->Connect(); + }; + } + + if ($res) { + Log3( $name, 2, "S7_connect: $name Could not connect to PLC ($res)" ); + return; + } + + my $PDUlength = $hash->{S7PLCClient}->{PDULength}; + $hash->{maxPDUlength} = $PDUlength; + + Log3( $name, 3, + "$name S7_connect: connect to PLC with maxPDUlength=$PDUlength" ); + + $hash->{STATE} = "connected to PLC"; + main::readingsSingleUpdate( $hash, "state", "connected to PLC", 1 ); + + return undef; + +} + +##################################### +sub S7_disconnect($) { #S5 OK + my $hash = shift @_; + my ( $ph, $res, $di ); + my $name = $hash->{NAME}; + my $error = ""; + + $hash->{S7PLCClient}->Disconnect() if ( defined( $hash->{S7PLCClient} ) ); + $hash->{S7PLCClient} = undef; #PLC Client freigeben + + $hash->{STATE} = "disconnected"; + main::readingsSingleUpdate( $hash, "state", "disconnected", 1 ); + + Log3( $name, 2, "$name S7 disconnected" ); + +} + +##################################### +sub S7_reconnect($) { #S5 OK + my $hash = shift @_; + S7_disconnect($hash) if ( defined( $hash->{S7PLCClient} ) ); + + if ( $hash->{S7TYPE} eq "S5" ) { + $hash->{S7PLCClient} = S5Client->new(); + } + else { + $hash->{S7PLCClient} = S7Client->new(); + } + InternalTimer( gettimeofday() + 3, "S7_connect", $hash, 1 ) + ; #wait 3 seconds for reconnect +} + +##################################### +sub S7_Define($$) { # S5 OK + my ( $hash, $def ) = @_; + my @a = split( "[ \t][ \t]*", $def ); + + my ( $name, $PLC_address, $LocalTSAP, $RemoteTSAP, $res, $PDUlength, $rack, + $slot ); + + $name = $a[0]; + + if ( uc $a[2] eq "S5" ) { + $hash->{S7TYPE} = "S5"; + $PLC_address = $a[3]; + if (@a > 4) { + $hash->{Interval} = $a[4]; + } else { + $hash->{Interval} = 1; + } + $LocalTSAP = -1; + $RemoteTSAP = -1; + + $PDUlength = 240; + + } + elsif ( uc $a[2] eq "LOGO7" || uc $a[2] eq "LOGO8" ) { + $PLC_address = $a[3]; + $LocalTSAP = 0x0100; + $RemoteTSAP = 0x0200; + if (@a > 4) { + $hash->{Interval} = $a[4]; + } else { + $hash->{Interval} = 1; + } + if ( uc $a[2] eq "LOGO7" ) { + $hash->{S7TYPE} = "LOGO7"; + } + else { + $hash->{S7TYPE} = "LOGO8"; + } + $PDUlength = 240; + + } + else { + + $PLC_address = $a[2]; + + $rack = int( $a[3] ); + return "invalid rack parameter (0 - 15)" + if ( $rack < 0 || $rack > 15 ); + + $slot = int( $a[4] ); + return "invalid slot parameter (0 - 15)" + if ( $slot < 0 || $slot > 15 ); + + $hash->{Interval} = 1; + if ( int(@a) == 6 ) { + $hash->{Interval} = int( $a[5] ); + return "invalid intervall parameter (1 - 86400)" + if ( $hash->{Interval} < 1 || $hash->{Interval} > 86400 ); + } + $LocalTSAP = 0x0100; + $RemoteTSAP = ( &S7Client::S7_PG << 8 ) + ( $rack * 0x20 ) + $slot; + + $PDUlength = 0x3c0; + + $hash->{S7TYPE} = "NATIVE"; + } + + $hash->{plcAddress} = $PLC_address; + $hash->{LocalTSAP} = $LocalTSAP; + $hash->{RemoteTSAP} = $RemoteTSAP; + $hash->{maxPDUlength} = $PDUlength; #initial PDU length + + Log3 $name, 4, +"S7: define $name PLC_address=$PLC_address,LocalTSAP=$LocalTSAP, RemoteTSAP=$RemoteTSAP "; + + $hash->{STATE} = "disconnected"; + main::readingsSingleUpdate( $hash, "state", "disconnected", 1 ); + + S7_connect($hash); + + InternalTimer( gettimeofday() + $hash->{Interval}, + "S7_GetUpdate", $hash, 0 ); + + return undef; +} + +##################################### +sub S7_Undef($) { #S5 OK + my $hash = shift; + + RemoveInternalTimer($hash); + + S7_disconnect($hash); + + delete( $modules{S7}{defptr} ); + + return undef; +} + + +##################################### +sub S7_Set($@) { + + +} + + +##################################### +sub S7_Get($@) { #S5 OK + my ( $hash, @a ) = @_; + return "Need at least one parameters" if ( @a < 2 ); + return "Unknown argument $a[1], choose one of " + . join( " ", sort keys %gets ) + if ( !defined( $gets{ $a[1] } ) ); + my $name = shift @a; + my $cmd = shift @a; + + ARGUMENT_HANDLER: { + $cmd eq "S7TCPClientVersion" and do { + + return $hash->{S7PLCClient}->version(); + last; + }; + $cmd eq "PLCTime" and do { + return $hash->{S7PLCClient}->getPLCDateTime(); + last; + }; + } + +} + +##################################### +sub S7_Attr(@) { + my ( $cmd, $name, $aName, $aVal ) = @_; + + my $hash = $defs{$name}; + + # $cmd can be "del" or "set" + # $name is device name + # aName and aVal are Attribute name and value + + if ( $cmd eq "set" ) { + if ( $aName eq "MaxMessageLength" ) { + + if ( $aVal < $hash->{S7PLCClient}->{MaxReadLength} ) { + + $hash->{S7PLCClient}->{MaxReadLength} = $aVal; + + Log3( $name, 3, "$name S7_Attr: setting MaxReadLength= $aVal" ); + } + } elsif ($aName eq "MaxMessageLength") { + if ( $aVal >= 1 ) { + + $hash->{Interval} = $aVal; + + Log3( $name, 3, "$name S7_Attr: setting Intervall= $aVal" ); + } + } + ########### + + if ( $aName eq "WriteInputs-Config" + || $aName eq "WriteOutputs-Config" + || $aName eq "WriteFlags-Config" + || $aName eq "WriteDB-Config" ) + { + my $PDUlength = $hash->{maxPDUlength}; + + my @a = split( "[ \t][ \t]*", $aVal ); + if ( int(@a) % 3 != 0 || int(@a) == 0 ) { + Log3( $name, 3, + "S7: Invalid $aName in attr $name $aName $aVal: $@" ); + return +"Invalid $aName $aVal \n Format: [ ]"; + } + else { + + for ( my $i = 0 ; $i < int(@a) ; $i++ ) { + if ( $a[$i] ne int( $a[$i] ) ) { + my $s = $a[$i]; + Log3( $name, 3, +"S7: Invalid $aName in attr $name $aName $aVal ($s is not a number): $@" + ); + return "Invalid $aName $aVal: $s is not a number"; + } + if ( $i % 3 == 0 && ( $a[$i] < 0 || $a[$i] > 1024 ) ) { + Log3( $name, 3, + "S7: Invalid $aName db. valid db 0 - 1024: $@" ); + return + "Invalid $aName length: $aVal db: valid db 0 - 1024"; + + } + if ( $i % 3 == 1 && ( $a[$i] < 0 || $a[$i] > 32768 ) ) { + Log3( $name, 3, +"S7: Invalid $aName startposition. valid startposition 0 - 32768: $@" + ); + return +"Invalid $aName startposition: $aVal db: valid startposition 0 - 32768"; + + } + if ( $i % 3 == 2 + && ( $a[$i] < 1 || $a[$i] > $PDUlength ) ) + { + Log3( $name, 3, +"S7: Invalid $aName length. valid length 1 - $PDUlength: $@" + ); + return +"Invalid $aName lenght: $aVal: valid length 1 - $PDUlength"; + } + + } + + return undef if ( $hash->{STATE} ne "connected to PLC" ); + + #we need to fill-up the internal buffer from current PLC values + my $hash = $defs{$name}; + + my $res = + S7_getAllWritingBuffersFromPLC( $hash, $aName, $aVal ); + if ( int($res) != 0 ) { + + #quit because of error + return $res; + } + + } + } + } + return undef; +} + +##################################### + +sub S7_getAreaIndex4AreaName($) { #S5 OK + my ($aName) = @_; + + my $AreaIndex = -1; + for ( my $j = 0 ; $j < int(@areaname) ; $j++ ) { + if ( $aName eq $areasconfig[$j] || $aName eq $areaname[$j] ) { + $AreaIndex = $j; + last; + } + } + if ( $AreaIndex < 0 ) { + Log3( undef, 2, "S7_Attr: Internal error invalid WriteAreaIndex" ); + return "Internal error invalid WriteAreaIndex"; + } + return $AreaIndex; + +} + +##################################### +sub S7_WriteToPLC($$$$$$) { + my ( $hash, $areaIndex, $dbNr, $startByte, $WordLen, $dataBlock ) = @_; + + my $PDUlength = -1; + if ( defined $hash->{maxPDUlength} ) { + $PDUlength = $hash->{maxPDUlength}; + } + my $name = $hash->{NAME}; + + my $res = -1; + my $Bufferlength = 59999; + $Bufferlength = length($dataBlock); + + if ( $Bufferlength <= $PDUlength ) { + if ( $hash->{STATE} eq "connected to PLC" ) { + + my $bss = join( ", ", unpack( "H2" x $Bufferlength, $dataBlock ) ); + Log3( $name, 5, +"$name S7_WriteToPLC: Write Bytes to PLC: $areaIndex, $dbNr,$startByte , $Bufferlength, $bss" + ); + + eval { + local $SIG{__DIE__} = sub { + my ($s) = @_; + print "DIE:$s"; + Log3( $hash, 0, "DIE:$s" ); + $res = -2; + }; + + if ( $hash->{S7TYPE} eq "S5" ) { + $res = $hash->{S7PLCClient}->S5WriteS5Bytes( + $s7areas[$areaIndex], $dbNr, $startByte, $Bufferlength, + $dataBlock + ); + } + else { + $res = + $hash->{S7PLCClient} + ->WriteArea( $s7areas[$areaIndex], $dbNr, $startByte, + $Bufferlength, $WordLen, $dataBlock ); + } + + }; + if ( $res != 0 ) { + my $error = $hash->{S7PLCClient}->getErrorStr($res); + + my $msg = "$name S7_WriteToPLC WriteArea error: $res=$error"; + Log3( $name, 3, $msg ); + + S7_reconnect($hash); #lets try a reconnect + return ( -2, $msg ); + } + } + else { + my $msg = "$name S7_WriteToPLC: PLC is not connected "; + + Log3( $name, 3, $msg ); + + S7_reconnect($hash); #lets try a reconnect + + return ( -2, $msg ); + } + + } + else { + my $msg = +"S7_WriteToPLC: wrong block length $Bufferlength (max length $PDUlength)"; + Log3( $name, 3, $msg ); + return ( -1, $msg ); + } +} +##################################### +sub S7_WriteBitToPLC($$$$$) { + my ( $hash, $areaIndex, $dbNr, $bitPosition, $bitValue ) = @_; + + my $PDUlength = -1; + if ( defined $hash->{maxPDUlength} ) { + $PDUlength = $hash->{maxPDUlength}; + } + my $name = $hash->{NAME}; + + my $res = -1; + my $Bufferlength = 1; + + if ( $Bufferlength <= $PDUlength ) { + if ( $hash->{STATE} eq "connected to PLC" ) { + + my $bss = join( ", ", unpack( "H2" x $Bufferlength, $bitValue ) ); + Log3( $name, 5, +"$name S7_WriteBitToPLC: Write Bytes to PLC: $areaIndex, $dbNr, $bitPosition , $Bufferlength, $bitValue" + ); + + eval { + local $SIG{__DIE__} = sub { + my ($s) = @_; + print "DIE:$s"; + Log3 $hash, 0, "DIE:$s"; + $res = -2; + }; + + if ( $hash->{S7TYPE} eq "S5" ) { + + #todo fix S5 Handling + } + else { + $res = + $hash->{S7PLCClient} + ->WriteArea( $s7areas[$areaIndex], $dbNr, $bitPosition, + $Bufferlength, &S7Client::S7WLBit, chr($bitValue) ); + } + }; + if ( $res != 0 ) { + my $error = $hash->{S7PLCClient}->getErrorStr($res); + + my $msg = "$name S7_WriteBitToPLC WriteArea error: $res=$error"; + Log3 $name, 3, $msg; + + S7_reconnect($hash); #lets try a reconnect + return ( -2, $msg ); + } + } + else { + my $msg = "$name S7_WriteBitToPLC: PLC is not connected "; + Log3 $name, 3, $msg; + return ( -1, $msg ); + } + + } + else { + my $msg = +"S7_WriteBitToPLC: wrong block length $Bufferlength (max length $PDUlength)"; + Log3 $name, 3, $msg; + return ( -1, $msg ); + } +} + +##################################### +#sub S7_WriteBlockToPLC($$$$$) { +# my ( $hash, $areaIndex, $dbNr, $startByte, $dataBlock ) = @_; +# +# +# return S7_WriteToPLC($hash, $areaIndex, $dbNr, $startByte, &S7Client::S7WLByte, $dataBlock); +# +#} +##################################### + +sub S7_ReadBlockFromPLC($$$$$) { + my ( $hash, $areaIndex, $dbNr, $startByte, $requestedLength ) = @_; + + my $PDUlength = -1; + if ( defined $hash->{maxPDUlength} ) { + $PDUlength = $hash->{maxPDUlength}; + } + my $name = $hash->{NAME}; + my $readbuffer = ""; + my $res = -1; + + if ( $requestedLength <= $PDUlength ) { + if ( $hash->{STATE} eq "connected to PLC" ) { + + eval { + local $SIG{__DIE__} = sub { + my ($s) = @_; + print "DIE:$s"; + Log3 $hash, 0, "DIE:$s"; + $res = -2; + }; + + if ( $hash->{S7TYPE} eq "S5" ) { + ( $res, $readbuffer ) = + $hash->{S7PLCClient} + ->S5ReadS5Bytes( $s7areas[$areaIndex], $dbNr, $startByte, + $requestedLength ); + } + else { + ( $res, $readbuffer ) = + $hash->{S7PLCClient} + ->ReadArea( $s7areas[$areaIndex], $dbNr, $startByte, + $requestedLength, &S7Client::S7WLByte ); + } + }; + + if ( $res != 0 ) { + + my $error = $hash->{S7PLCClient}->getErrorStr($res); + my $msg = + "$name S7_ReadBlockFromPLC ReadArea error: $res=$error"; + Log3( $name, 3, $msg ); + + S7_reconnect($hash); #lets try a reconnect + return ( -2, $msg ); + } + else { + + #reading was OK + return ( 0, $readbuffer ); + } + } + else { + my $msg = "$name S7_ReadBlockFromPLC: PLC is not connected "; + Log3( $name, 3, $msg ); + return ( -1, $msg ); + + } + } + else { + my $msg = +"$name S7_ReadBlockFromPLC: wrong block length (max length $PDUlength)"; + Log3( $name, 3, $msg ); + return ( -1, $msg ); + } +} + +##################################### + +sub S7_setBitInBuffer($$$) { #S5 OK + my ( $bitPosition, $buffer, $newValue ) = @_; + + my $Bufferlength = ( length($buffer) + 1 ) / 3; + my $bytePosition = int( $bitPosition / 8 ); + +# Log3 undef, 3, "S7_setBitInBuffer in: ".length($buffer)." , $Bufferlength , $bytePosition , $bitPosition"; + + if ( $bytePosition < 0 || $bytePosition > $Bufferlength - 1 ) { + + #out off buffer request !!!!! + # Log3 undef, 3, "S7_setBitInBuffer out -1 : ".length($buffer); + + return ( -1, undef ); + } + + my @Writebuffer = unpack( "C" x $Bufferlength, + pack( "H2" x $Bufferlength, split( ",", $buffer ) ) ); + + my $intrestingBit = $bitPosition % 8; + + if ( $newValue eq "on" || $newValue eq "trigger" ) { + $Writebuffer[$bytePosition] |= ( 1 << $intrestingBit ); + } + else { + $Writebuffer[$bytePosition] &= ( ( ~( 1 << $intrestingBit ) ) & 0xff ); + } + + my $resultBuffer = join( + ",", + unpack( + "H2" x $Bufferlength, + pack( "C" x $Bufferlength, @Writebuffer ) + ) + ); + + $Bufferlength = length($resultBuffer); + + # Log3 undef, 3, "S7_setBitInBuffer out: $Bufferlength"; + + return ( 0, $resultBuffer ); +} + +##################################### +sub S7_getBitFromBuffer($$) { #S5 OK + my ( $bitPosition, $buffer ) = @_; + + my $Bufferlength = ( length($buffer) * 3 ) - 1; + my $bytePosition = int( $bitPosition / 8 ); + if ( $bytePosition < 0 || $bytePosition > length($Bufferlength) ) { + + #out off buffer request !!!!! + return "unknown"; + } + my @Writebuffer = unpack( "C" x $Bufferlength, + pack( "H2" x $Bufferlength, split( ",", $buffer ) ) ); + + my $intrestingByte = $Writebuffer[$bytePosition]; + my $intrestingBit = $bitPosition % 8; + + if ( ( $intrestingByte & ( 1 << $intrestingBit ) ) != 0 ) { + + return "on"; + } + else { + return "off"; + } + +} + +##################################### +sub S7_getAllWritingBuffersFromPLC($$$) { #S5 OK + + #$hash ... from S7 physical modul + #$writerConfig ... writer Config + #$aName ... area name + + my ( $hash, $aName, $writerConfig ) = @_; + + Log3( $aName, 4, "S7: getAllWritingBuffersFromPLC called" ); + + my @a = split( "[ \t][ \t]*", $writerConfig ); + + my $PDUlength = $hash->{maxPDUlength}; + + my @writingBuffers = (); + my $readbuffer; + + my $writeAreaIndex = S7_getAreaIndex4AreaName($aName); + return $writeAreaIndex if ( $writeAreaIndex ne int($writeAreaIndex) ); + + my $nr = int(@a); + + # Log3 undef, 4, "S7: getAllWritingBuffersFromPLC $nr"; + + my $res; + for ( my $i = 0 ; $i < int(@a) ; $i = $i + 3 ) { + my $readbuffer; + my $res; + + my $dbnr = $a[$i]; + my $startByte = $a[ $i + 1 ]; + my $requestedLength = $a[ $i + 2 ]; + + ( $res, $readbuffer ) = + S7_ReadBlockFromPLC( $hash, $writeAreaIndex, $dbnr, $startByte, + $requestedLength ); + if ( $res == 0 ) { #reading was OK + my $hexbuffer = + join( ",", unpack( "H2" x length($readbuffer), $readbuffer ) ); + push( @writingBuffers, $hexbuffer ); + } + else { + + #error in reading so just return the error MSG + return $readbuffer; + } + } + + if ( int(@writingBuffers) > 0 ) { + $hash->{"${areaname[$writeAreaIndex]}_DBWRITEBUFFER"} = + join( " ", @writingBuffers ); + } + else { + $hash->{"${areaname[$writeAreaIndex]}_DBWRITEBUFFER"} = undef; + } + return 0; +} + +##################################### +sub S7_GetUpdate($) { + my ($hash) = @_; + my $name = $hash->{NAME}; + Log3( $name, 4, "S7: $name GetUpdate called ..." ); + + my $res = S7_readFromPLC($hash); + + if ( $res == 0 ) { + InternalTimer( gettimeofday() + $hash->{Interval}, + "S7_GetUpdate", $hash, 1 ); + } + else { + + #an error has occoured --> 10sec break + InternalTimer( gettimeofday() + 10, "S7_GetUpdate", $hash, 1 ); + } + +} + +##################################### +sub S7_dispatchMsg($$$$$$$$) { + my ( $hash, $msgprefix, $areaIndex, $dbNr, $startByte, $hexbuffer, $length, + $clientsNames ) + = @_; + + my $name = $hash->{NAME}; + my $dmsg = + $msgprefix . " " + . $areaname[$areaIndex] . " " + . $dbNr . " " + . $startByte . " " + . $length . " " + . $name . " " + . $hexbuffer . " " + . $clientsNames; + + Log3( $name, 5, $name . " S7_dispatchMsg " . $dmsg ); + + Dispatch( $hash, $dmsg, {} ); + +} +##################################### +sub S7_readAndDispatchBlockFromPLC($$$$$$$$$$) { #S5 OK + my ( + $hash, $area, $dbnr, + $blockstartpos, $blocklength, $hasAnalogReading, + $hasDigitalReading, $hasAnalogWriting, $hasDigitalWriting, + $clientsNames + ) = @_; + + my $name = $hash->{NAME}; + my $state = $hash->{STATE}; + my $areaIndex = S7_getAreaIndex4AreaName($area); + + Log3( $name, 4, + $name + . " READ Block AREA=" + . $area . " (" + . $areaIndex + . "), DB =" + . $dbnr + . ", ADDRESS=" + . $blockstartpos + . ", LENGTH=" + . $blocklength ); + + if ( $state ne "connected to PLC" ) { + Log3 $name, 3, "$name is disconnected ? --> reconnect"; + S7_reconnect($hash); #lets try a reconnect + #@nextreadings[ $i / 4 ] = $now + 10; #retry in 10s + return -2; + } + + my $res; + my $readbuffer; + + ( $res, $readbuffer ) = + S7_ReadBlockFromPLC( $hash, $areaIndex, $dbnr, $blockstartpos, + $blocklength ); + + if ( $res == 0 ) { + + #reading was OK + my $length = length($readbuffer); + my $hexbuffer = join( ",", unpack( "H2" x $length, $readbuffer ) ); + + #dispatch to reader + S7_dispatchMsg( $hash, "AR", $areaIndex, $dbnr, $blockstartpos, + $hexbuffer, $length, $clientsNames ) + if ( $hasAnalogReading > 0 ); + S7_dispatchMsg( $hash, "DR", $areaIndex, $dbnr, $blockstartpos, + $hexbuffer, $length, $clientsNames ) + if ( $hasDigitalReading > 0 ); + + #dispatch to writer + S7_dispatchMsg( $hash, "AW", $areaIndex, $dbnr, $blockstartpos, + $hexbuffer, $length, $clientsNames ) + if ( $hasAnalogWriting > 0 ); + S7_dispatchMsg( $hash, "DW", $areaIndex, $dbnr, $blockstartpos, + $hexbuffer, $length, $clientsNames ) + if ( $hasDigitalWriting > 0 ); + return 0; + } + else { + + #reading failed + return -1; + } + +} +##################################### +sub S7_getReadingsList($) { #S5 OK + my ($hash) = @_; + my $name = $hash->{NAME}; + + my @readings; + + # Jetzt suchen wir alle Readings + my @mykeys; + my %logoClients; + + @mykeys = + grep $defs{$_}{TYPE} =~ /^S7_/ && $defs{$_}{IODev}{NAME} eq $hash->{NAME}, + keys(%defs); + @logoClients{@mykeys} = + @defs{@mykeys}; #jetzt haben wir alle clients in logoClients + + #we need to find out the unique areas + my %tmphash = map { $logoClients{$_}{AREA} => 1 } keys %logoClients; + my @uniqueArea = keys %tmphash; + + foreach my $Area (@uniqueArea) { + my %logoClientsArea; + @mykeys = + grep $defs{$_}{TYPE} =~ /^S7_/ + && $defs{$_}{IODev}{NAME} eq $hash->{NAME} + && $defs{$_}{AREA} eq $Area, keys(%defs); + @logoClientsArea{@mykeys} = @defs{@mykeys}; + + #now we findout which DBs are used (unique) + %tmphash = map { $logoClientsArea{$_}{DB} => 1 } keys %logoClientsArea; + my @uniqueDB = keys %tmphash; + + foreach my $DBNr (@uniqueDB) { + + #now we filter all readinfy by DB! + my %logoClientsDB; + + @mykeys = + grep $defs{$_}{TYPE} =~ /^S7_/ + && $defs{$_}{IODev}{NAME} eq $hash->{NAME} + && $defs{$_}{AREA} eq $Area + && $defs{$_}{DB} == $DBNr, keys(%defs); + @logoClientsDB{@mykeys} = @defs{@mykeys}; + + #next step is, sorting all clients by ADDRESS + my @positioned = sort { + $logoClientsDB{$a}{ADDRESS} <=> $logoClientsDB{$b}{ADDRESS} + } keys %logoClientsDB; + + my $blockstartpos = -1; + my $blocklength = 0; + + my $hasAnalogReading = 0; + my $hasDigitalReading = 0; + my $hasAnalogWriting = 0; + my $hasDigitalWriting = 0; + my $clientsName = ""; + + for ( my $i = 0 ; $i < int(@positioned) ; $i++ ) { + if ( $blockstartpos < 0 ) { + + #we start a new block + $blockstartpos = + int( $logoClientsDB{ $positioned[$i] }{ADDRESS} ); + $blocklength = $logoClientsDB{ $positioned[$i] }{LENGTH}; + + $hasAnalogReading++ + if ( + $logoClientsDB{ $positioned[$i] }{TYPE} eq "S7_ARead" ); + $hasDigitalReading++ + if ( + $logoClientsDB{ $positioned[$i] }{TYPE} eq "S7_DRead" ); + $hasAnalogWriting++ + if ( $logoClientsDB{ $positioned[$i] }{TYPE} eq + "S7_AWrite" ); + $hasDigitalWriting++ + if ( $logoClientsDB{ $positioned[$i] }{TYPE} eq + "S7_DWrite" ); + + $clientsName = $logoClientsDB{ $positioned[$i] }{NAME}; + + } + else { + + if ( $logoClientsDB{ $positioned[$i] }{ADDRESS} + + $logoClientsDB{ $positioned[$i] }{LENGTH} - + $blockstartpos <= + $hash->{S7PLCClient}->{MaxReadLength} ) + { + + #extend existing block + if ( + int( $logoClientsDB{ $positioned[$i] }{ADDRESS} ) + + $logoClientsDB{ $positioned[$i] }{LENGTH} - + $blockstartpos > $blocklength ) + { + $blocklength = + int( $logoClientsDB{ $positioned[$i] }{ADDRESS} ) + + $logoClientsDB{ $positioned[$i] }{LENGTH} - + $blockstartpos; + + $hasAnalogReading++ + if ( $logoClientsDB{ $positioned[$i] }{TYPE} eq + "S7_ARead" ); + $hasDigitalReading++ + if ( $logoClientsDB{ $positioned[$i] }{TYPE} eq + "S7_DRead" ); + $hasAnalogWriting++ + if ( $logoClientsDB{ $positioned[$i] }{TYPE} eq + "S7_AWrite" ); + $hasDigitalWriting++ + if ( $logoClientsDB{ $positioned[$i] }{TYPE} eq + "S7_DWrite" ); + + } + $clientsName .= + "," . $logoClientsDB{ $positioned[$i] }{NAME}; + } + else { + + #block would exeed MaxReadLength + + #read and dispatch block from PLC + #block in liste speichern + push( + @readings, + [ + $logoClientsDB{ $positioned[$i] }{AREA}, + $logoClientsDB{ $positioned[$i] }{DB}, + $blockstartpos, + $blocklength, + $hasAnalogReading, + $hasDigitalReading, + $hasAnalogWriting, + $hasDigitalWriting, + $clientsName + ] + ); + + $hasAnalogReading = 0; + $hasDigitalReading = 0; + $hasAnalogWriting = 0; + $hasDigitalWriting = 0; + + #start new block new time + $blockstartpos = + int( $logoClientsDB{ $positioned[$i] }{ADDRESS} ); + $blocklength = + $logoClientsDB{ $positioned[$i] }{LENGTH}; + + $hasAnalogReading++ + if ( $logoClientsDB{ $positioned[$i] }{TYPE} eq + "S7_ARead" ); + $hasDigitalReading++ + if ( $logoClientsDB{ $positioned[$i] }{TYPE} eq + "S7_DRead" ); + $hasAnalogWriting++ + if ( $logoClientsDB{ $positioned[$i] }{TYPE} eq + "S7_AWrite" ); + $hasDigitalWriting++ + if ( $logoClientsDB{ $positioned[$i] }{TYPE} eq + "S7_DWrite" ); + + $clientsName = $logoClientsDB{ $positioned[$i] }{NAME}; + } + + } + + } + if ( $blockstartpos >= 0 ) { + + #read and dispatch block from PLC + + push( + @readings, + [ + $logoClientsDB{ $positioned[ int(@positioned) - 1 ] } + {AREA}, + $logoClientsDB{ $positioned[ int(@positioned) - 1 ] } + {DB}, + $blockstartpos, + $blocklength, + $hasAnalogReading, + $hasDigitalReading, + $hasAnalogWriting, + $hasDigitalWriting, + $clientsName + ] + ); + + } + } + } + @{ $hash->{ReadingList} } = @readings; + return 0; + +} + +##################################### +sub S7_readFromPLC($) { #S5 OK + my ($hash) = @_; + my $name = $hash->{NAME}; + my $res; + + if ( ( !defined( $hash->{dirty} ) ) || $hash->{dirty} == 1 ) { + S7_getReadingsList($hash); + $hash->{dirty} = 0; + } + + my @readingList = @{ $hash->{ReadingList} }; + + for ( my $i = 0 ; $i < int(@readingList) ; $i++ ) { + my @readingSet = @{ $readingList[$i] }; + $res = S7_readAndDispatchBlockFromPLC( + $hash, $readingSet[0], $readingSet[1], $readingSet[2], + $readingSet[3], $readingSet[4], $readingSet[5], $readingSet[6], + $readingSet[7], $readingSet[8] + ); + + return $res if ( $res != 0 ); + } + return 0; +} + +1; + +=pod +=item summary basic interface to a SIEMENS S7 / S5 +=item summary_DE Schnittstelle zu einer Siemens S7 / S5 +=begin html + + +

    S7

    +
      +This module connects a SIEMENS PLC (Note: also SIEMENS Logo is supported). +The TCP communication module is based on settimino (http://settimino.sourceforge.net) + +You can found a german wiki here: httl://www.fhemwiki.de/wiki/S7 + +

      +For the communication the following modules have been implemented: +
        +
      • S7 … sets up the communication channel to the PLC
        • +
      • S7_ARead … Is used for reading integer Values from the PLC
        • +
      • S7_AWrite … Is used for write integer Values to the PLC
        • +
      • S7_DRead … Is used for read bits
        • +
      • S7_DWrite … Is used for writing bits.
        • +
      +
      +
      +Reading work flow: +
      +
      + +The S7 module reads periodically the configured DB areas from the PLC and stores the data in an internal buffer. Then all reading client modules are informed. Each client module extracts his data and the corresponding readings are set. + + +Writing work flow: +
      +
      +At the S7 module you need to configure the PLC writing target. Also the S7 module holds a writing buffer. Which contains a master copy of the data needs to send. +
      +(Note: after configuration of the writing area a copy from the PLC is read and used as initial fill-up of the writing buffer) +
      +Note: The S7 module will send always the whole data block to the PLC. +When data on the clients modules is set then the client module updates the internal writing buffer on the S7 module and triggers the writing to the PLC. +
      +
      + + +Define +
        +define <name> S7 <PLC_address> <rack> <slot> [<Interval>]

        + +define logo S7 10.0.0.241 2 0
        + +
          +
        • PLC_address … IP address of the S7 PLC (For S5 see below)
          • +
        • rack … rack of the PLC
          • +
        • slot … slot of the PLC
          • +
        • Interval … Intervall how often the modul should check if a reading is required
          • +
        +
        +Note: For Siemens logo you should use a alternative (more simply configuration method):
        +define logo S7 LOGO7 10.0.0.241 +
      +
    +
    +Note: For Siemens S5 you must use a alternative (more simply configuration method):
    +define logo S7 S5 /dev/tty1 + +in this case the PLC_address is the serial port number +
+ +

+Attr
+The following attributes are supported:
+
    +
  • MaxMessageLength
    • +
    +MaxMessageLength ... restricts the packet length if lower than the negioated PDULength. This could be used to increate the processing speed. 2 small packages may be smaler than one large package + +=end html + +=begin html_DE + + + +

    S7

    +
      +This module connects a SIEMENS PLC (Note: also SIEMENS Logo is supported). +The TCP communication module is based on settimino (http://settimino.sourceforge.net) + +You can found a german wiki here: httl://www.fhemwiki.de/wiki/S7 + +

      +For the communication the following modules have been implemented: +
        +
      • S7 … sets up the communication channel to the PLC
        • +
      • S7_ARead … Is used for reading integer Values from the PLC
        • +
      • S7_AWrite … Is used for write integer Values to the PLC
        • +
      • S7_DRead … Is used for read bits
        • +
      • S7_DWrite … Is used for writing bits.
        • +
      +
      +
      +Reading work flow: +
      +
      + +The S7 module reads periodically the configured DB areas from the PLC and stores the data in an internal buffer. Then all reading client modules are informed. Each client module extracts his data and the corresponding readings are set. + + +Writing work flow: +
      +
      +At the S7 module you need to configure the PLC writing target. Also the S7 module holds a writing buffer. Which contains a master copy of the data needs to send. +
      +(Note: after configuration of the writing area a copy from the PLC is read and used as initial fill-up of the writing buffer) +
      +Note: The S7 module will send always the whole data block to the PLC. +When data on the clients modules is set then the client module updates the internal writing buffer on the S7 module and triggers the writing to the PLC. +
      +
      + + +Define +
        +define <name> S7 <PLC_address> <rack> <slot> [<Interval>]

        + +define logo S7 10.0.0.241 2 0
        + +
          +
        • PLC_address … IP address of the S7 PLC (For S5 see below)
          • +
        • rack … rack of the PLC
          • +
        • slot … slot of the PLC
          • +
        • Interval … Intervall how often the modul should check if a reading is required
          • +
        +
        +Note: For Siemens logo you should use a alternative (more simply configuration method):
        +define logo S7 LOGO7 10.0.0.241 +
      +
    +
    +Note: For Siemens S5 you must use a alternative (more simply configuration method):
    +define logo S7 S5 /dev/tty1 + +in this case the PLC_address is the serial port number +
+ +

+Attr
+The following attributes are supported:
+
    +
  • MaxMessageLength
    • +
    +MaxMessageLength ... restricts the packet length if lower than the negioated PDULength. This could be used to increate the processing speed. 2 small packages may be smaler than one large package +=end html_DE + +=cut \ No newline at end of file diff --git a/fhem/FHEM/44_S7_ARead.pm b/fhem/FHEM/44_S7_ARead.pm index 7c103957c..9bbb58f9f 100644 --- a/fhem/FHEM/44_S7_ARead.pm +++ b/fhem/FHEM/44_S7_ARead.pm @@ -180,25 +180,25 @@ sub S7_ARead_Parse($$) { my $myI; if ( $h->{DATATYPE} eq "u8" ) { - $myI = $hash->{S7TCPClient}->ByteAt( \@Writebuffer, $s ); + $myI = $hash->{S7PLCClient}->ByteAt( \@Writebuffer, $s ); } elsif ( $h->{DATATYPE} eq "s8" ) { - $myI = $hash->{S7TCPClient}->ShortAt( \@Writebuffer, $s ); + $myI = $hash->{S7PLCClient}->ShortAt( \@Writebuffer, $s ); } elsif ( $h->{DATATYPE} eq "u16" ) { - $myI = $hash->{S7TCPClient}->WordAt( \@Writebuffer, $s ); + $myI = $hash->{S7PLCClient}->WordAt( \@Writebuffer, $s ); } elsif ( $h->{DATATYPE} eq "s16" ) { - $myI = $hash->{S7TCPClient}->IntegerAt( \@Writebuffer, $s ); + $myI = $hash->{S7PLCClient}->IntegerAt( \@Writebuffer, $s ); } elsif ( $h->{DATATYPE} eq "u32" ) { - $myI = $hash->{S7TCPClient}->DWordAt( \@Writebuffer, $s ); + $myI = $hash->{S7PLCClient}->DWordAt( \@Writebuffer, $s ); } elsif ( $h->{DATATYPE} eq "s32" ) { - $myI = $hash->{S7TCPClient}->DintAt( \@Writebuffer, $s ); + $myI = $hash->{S7PLCClient}->DintAt( \@Writebuffer, $s ); } elsif ( $h->{DATATYPE} eq "float" ) { - $myI = $hash->{S7TCPClient}->FloatAt( \@Writebuffer, $s ); + $myI = $hash->{S7PLCClient}->FloatAt( \@Writebuffer, $s ); } else { Log3 $name, 3, @@ -256,34 +256,34 @@ sub S7_ARead_Parse($$) { if ( $h->{DATATYPE} eq "u8" ) { $myI = - $hash->{S7TCPClient}->ByteAt( \@Writebuffer, $s ); + $hash->{S7PLCClient}->ByteAt( \@Writebuffer, $s ); } elsif ( $h->{DATATYPE} eq "s8" ) { $myI = - $hash->{S7TCPClient} + $hash->{S7PLCClient} ->ShortAt( \@Writebuffer, $s ); } elsif ( $h->{DATATYPE} eq "u16" ) { $myI = - $hash->{S7TCPClient}->WordAt( \@Writebuffer, $s ); + $hash->{S7PLCClient}->WordAt( \@Writebuffer, $s ); } elsif ( $h->{DATATYPE} eq "s16" ) { $myI = - $hash->{S7TCPClient} + $hash->{S7PLCClient} ->IntegerAt( \@Writebuffer, $s ); } elsif ( $h->{DATATYPE} eq "u32" ) { $myI = - $hash->{S7TCPClient} + $hash->{S7PLCClient} ->DWordAt( \@Writebuffer, $s ); } elsif ( $h->{DATATYPE} eq "s32" ) { $myI = - $hash->{S7TCPClient}->DintAt( \@Writebuffer, $s ); + $hash->{S7PLCClient}->DintAt( \@Writebuffer, $s ); } elsif ( $h->{DATATYPE} eq "float" ) { $myI = - $hash->{S7TCPClient} + $hash->{S7PLCClient} ->FloatAt( \@Writebuffer, $s ); } else { @@ -364,43 +364,45 @@ sub S7_ARead_Attr(@) { 1; =pod +=item summary logical device for a analog reading from a S7/S5 +=item summary_DE logisches Device für einen analogen Nur Lese Datenpunkt von einer S5 / S7 =begin html

    S7_ARead

      - This module is a logical module of the physical module S7.
      - This module provides analog data (signed / unsigned integer Values).
      - Note: you have to configure a PLC reading at the physical module (S7) first.
      -
      -
      - Define
      - define <name> S7_ARead {inputs|outputs|flags|db} <DB> <start> {u8|s8|u16|s16|u32|s32}
      -   -
        -
      • inputs|outputs|flags|db … defines where to read.
        • -
      • DB … Number of the DB
        • -
      • start … start byte of the reading
        • -
      • {u8|s8|u16|s16|u32|s32} … defines the datatype: -
          -
        • u8 …. unsigned 8 Bit integer
          • -
        • s8 …. signed 8 Bit integer
          • -
        • u16 …. unsigned 16 Bit integer
          • -
        • s16 …. signed 16 Bit integer
          • -
        • u32 …. unsigned 32 Bit integer
          • -
        • s32 …. signed 32 Bit integer
          • -
        -
        • -
      • Note: the required memory area (start – start + datatypelength) need to be with in the configured PLC reading of the physical module.
        • -
      -
      - Attr
      - The following parameters are used to scale every reading -
        -
      • multiplicator
        • -
      • offset
        • -
      - newValue = <multiplicator> * Value + <offset> + +This module is a logical module of the physical module S7.
      +This module provides analog data (signed / unsigned integer Values).
      +Note: you have to configure a PLC reading at the physical module (S7) first.
      +

      +Define
      +define <name> S7_ARead {inputs|outputs|flags|db} <DB> <start> {u8|s8|u16|s16|u32|s32} +

      +
        +
      • inputs|outputs|flags|db … defines where to read.
        • +
      • DB … Number of the DB
        • +
      • start … start byte of the reading
        • +
      • {u8|s8|u16|s16|u32|s32} … defines the datatype:
        • +
          +
        • u8 …. unsigned 8 Bit integer
          • +
        • s8 …. signed 8 Bit integer
          • +
        • u16 …. unsigned 16 Bit integer
          • +
        • s16 …. signed 16 Bit integer
          • +
        • u32 …. unsigned 32 Bit integer
          • +
        • s32 …. signed 32 Bit integer
          • +
        +Note: the required memory area (start – start + datatypelength) need to be with in the configured PLC reading of the physical module. +
      +
      +Attr
      +The following parameters are used to scale every reading
      +
        +
      • multiplicator
        • +
      • offset
        • +
      + +newValue = <multiplicator> * Value + <offset>
    =end html @@ -409,40 +411,38 @@ sub S7_ARead_Attr(@) {

    S7_ARead

      - This module is a logical module of the physical module S7.
      - This module provides analog data (signed / unsigned integer Values).
      - Note: you have to configure a PLC reading at the physical module (S7) first.
      -
      -
      - Define
      - define <name> S7_ARead {inputs|outputs|flags|db} <DB> <start> {u8|s8|u16|s16|u32|s32}
      -   -
        -
      • inputs|outputs|flags|db … defines where to read.
        • -
      • DB … Number of the DB
        • -
      • start … start byte of the reading
        • -
      • {u8|s8|u16|s16|u32|s32} … defines the datatype: -
          -
        • u8 …. unsigned 8 Bit integer
          • -
        • s8 …. signed 8 Bit integer
          • -
        • u16 …. unsigned 16 Bit integer
          • -
        • s16 …. signed 16 Bit integer
          • -
        • u32 …. unsigned 32 Bit integer
          • -
        • s32 …. signed 32 Bit integer
          • -
        • float …. 4 byte float
          • -
        -
        • -
      • Note: the required memory area (start – start + datatypelength) need to be with in the configured PLC reading of the physical module.
        • -
      - Attr
      - The following parameters are used to scale every reading -
        -
      • multiplicator
        • -
      • offset
        • -
      - newValue = <multiplicator> * Value + <offset> + +This module is a logical module of the physical module S7.
      +This module provides analog data (signed / unsigned integer Values).
      +Note: you have to configure a PLC reading at the physical module (S7) first.
      +

      +Define
      +define <name> S7_ARead {inputs|outputs|flags|db} <DB> <start> {u8|s8|u16|s16|u32|s32} +

      +
        +
      • inputs|outputs|flags|db … defines where to read.
        • +
      • DB … Number of the DB
        • +
      • start … start byte of the reading
        • +
      • {u8|s8|u16|s16|u32|s32} … defines the datatype:
        • +
          +
        • u8 …. unsigned 8 Bit integer
          • +
        • s8 …. signed 8 Bit integer
          • +
        • u16 …. unsigned 16 Bit integer
          • +
        • s16 …. signed 16 Bit integer
          • +
        • u32 …. unsigned 32 Bit integer
          • +
        • s32 …. signed 32 Bit integer
          • +
        • float …. 4 byte float
          • +
        +Note: the required memory area (start – start + datatypelength) need to be with in the configured PLC reading of the physical module. +
      +Attr +The following parameters are used to scale every reading +
        +
      • multiplicator
        • +
      • offset
        • +
      +newValue = <multiplicator> * Value + <offset>
    =end html_DE -=cut - +=cut \ No newline at end of file diff --git a/fhem/FHEM/44_S7_AWrite.pm b/fhem/FHEM/44_S7_AWrite.pm index 1144458c1..824c9cb49 100644 --- a/fhem/FHEM/44_S7_AWrite.pm +++ b/fhem/FHEM/44_S7_AWrite.pm @@ -210,7 +210,7 @@ sub S7_AWrite_Set($@) { my $dbNR = $hash->{DB}; my $shash = $defs{$sname}; - if ( !defined( $shash->{S7TCPClient} ) ) { + if ( !defined( $shash->{S7PLCClient} ) ) { my $err = "$name S7_AWrite_Set: not connected to PLC "; Log3 $name, 3, $err; return $err; @@ -227,32 +227,40 @@ sub S7_AWrite_Set($@) { my $WordLen; if ( $datatype eq "u8" ) { - $b = $shash->{S7TCPClient}->setByteAt( "X", 0, $newValue ); + $b = $shash->{S7PLCClient}->setByteAt( "X", 0, $newValue ); $WordLen = &S7Client::S7WLByte; } elsif ( $datatype eq "s8" ) { - $b = $shash->{S7TCPClient}->setShortAt( "X", 0, $newValue ); + $b = $shash->{S7PLCClient}->setShortAt( "X", 0, $newValue ); $WordLen = &S7Client::S7WLByte; } elsif ( $datatype eq "u16" ) { - $b = $shash->{S7TCPClient}->setWordAt( "XX", 0, $newValue ); - $WordLen = &S7Client::S7WLByte; + $b = $shash->{S7PLCClient}->setWordAt( "XX", 0, $newValue ); + $WordLen = &S7Client::S7WLInt; + + # $WordLen = &S7Client::S7WLWord; } elsif ( $datatype eq "s16" ) { - $b = $shash->{S7TCPClient}->setIntegerAt( "XX", 0, $newValue ); - $WordLen = &S7Client::S7WLByte; + $b = $shash->{S7PLCClient}->setIntegerAt( "XX", 0, $newValue ); + $WordLen = &S7Client::S7WLInt; + + # $WordLen = &S7Client::S7WLWord; } elsif ( $datatype eq "u32" ) { - $b = $shash->{S7TCPClient}->setDWordAt( "XXXX", 0, $newValue ); - $WordLen = &S7Client::S7WLByte; + $b = $shash->{S7PLCClient}->setDWordAt( "XXXX", 0, $newValue ); + $WordLen = &S7Client::S7WLDInt; + + # $WordLen = &S7Client::S7WLDWord; } elsif ( $datatype eq "s32" ) { - $b = $shash->{S7TCPClient}->setDintAt( "XXXX", 0, $newValue ); - $WordLen = &S7Client::S7WLByte; + $b = $shash->{S7PLCClient}->setDintAt( "XXXX", 0, $newValue ); + $WordLen = &S7Client::S7WLDInt; + + # $WordLen = &S7Client::S7WLDWord; } elsif ( $datatype eq "float" ) { - $b = $shash->{S7TCPClient}->setFloatAt( "XXXX", 0, $newValue ); - $WordLen = &S7Client::S7WLByte; + $b = $shash->{S7PLCClient}->setFloatAt( "XXXX", 0, $newValue ); + $WordLen = &S7Client::S7WLReal; } else { my $err = "$name S7_AWrite: Parse unknown type : (" . $datatype . ")"; @@ -304,7 +312,7 @@ sub S7_AWrite_Parse($$) { my $ID = "$area $DB"; - Log3 $name, 6, "$name S7_AWrite_Parse $rmsg"; + Log3 $name, 5, "$name S7_AWrite_Parse $rmsg"; my @clientList = split( ",", $clientNames ); if ( int(@clientList) > 0 ) { @@ -330,25 +338,25 @@ sub S7_AWrite_Parse($$) { my $myI; if ( $h->{DATATYPE} eq "u8" ) { - $myI = $hash->{S7TCPClient}->ByteAt( \@Writebuffer, $s ); + $myI = $hash->{S7PLCClient}->ByteAt( \@Writebuffer, $s ); } elsif ( $h->{DATATYPE} eq "s8" ) { - $myI = $hash->{S7TCPClient}->ShortAt( \@Writebuffer, $s ); + $myI = $hash->{S7PLCClient}->ShortAt( \@Writebuffer, $s ); } elsif ( $h->{DATATYPE} eq "u16" ) { - $myI = $hash->{S7TCPClient}->WordAt( \@Writebuffer, $s ); + $myI = $hash->{S7PLCClient}->WordAt( \@Writebuffer, $s ); } elsif ( $h->{DATATYPE} eq "s16" ) { - $myI = $hash->{S7TCPClient}->IntegerAt( \@Writebuffer, $s ); + $myI = $hash->{S7PLCClient}->IntegerAt( \@Writebuffer, $s ); } elsif ( $h->{DATATYPE} eq "u32" ) { - $myI = $hash->{S7TCPClient}->DWordAt( \@Writebuffer, $s ); + $myI = $hash->{S7PLCClient}->DWordAt( \@Writebuffer, $s ); } elsif ( $h->{DATATYPE} eq "s32" ) { - $myI = $hash->{S7TCPClient}->DintAt( \@Writebuffer, $s ); + $myI = $hash->{S7PLCClient}->DintAt( \@Writebuffer, $s ); } elsif ( $h->{DATATYPE} eq "float" ) { - $myI = $hash->{S7TCPClient}->FloatAt( \@Writebuffer, $s ); + $myI = $hash->{S7PLCClient}->FloatAt( \@Writebuffer, $s ); } else { Log3 $name, 3, "$name S7_AWrite: Parse unknown type : (" @@ -387,34 +395,34 @@ sub S7_AWrite_Parse($$) { if ( $h->{DATATYPE} eq "u8" ) { $myI = - $hash->{S7TCPClient}->ByteAt( \@Writebuffer, $s ); + $hash->{S7PLCClient}->ByteAt( \@Writebuffer, $s ); } elsif ( $h->{DATATYPE} eq "s8" ) { $myI = - $hash->{S7TCPClient} + $hash->{S7PLCClient} ->ShortAt( \@Writebuffer, $s ); } elsif ( $h->{DATATYPE} eq "u16" ) { $myI = - $hash->{S7TCPClient}->WordAt( \@Writebuffer, $s ); + $hash->{S7PLCClient}->WordAt( \@Writebuffer, $s ); } elsif ( $h->{DATATYPE} eq "s16" ) { $myI = - $hash->{S7TCPClient} + $hash->{S7PLCClient} ->IntegerAt( \@Writebuffer, $s ); } elsif ( $h->{DATATYPE} eq "u32" ) { $myI = - $hash->{S7TCPClient} + $hash->{S7PLCClient} ->DWordAt( \@Writebuffer, $s ); } elsif ( $h->{DATATYPE} eq "s32" ) { $myI = - $hash->{S7TCPClient}->DintAt( \@Writebuffer, $s ); + $hash->{S7PLCClient}->DintAt( \@Writebuffer, $s ); } elsif ( $h->{DATATYPE} eq "float" ) { $myI = - $hash->{S7TCPClient} + $hash->{S7PLCClient} ->FloatAt( \@Writebuffer, $s ); } else { @@ -431,7 +439,7 @@ sub S7_AWrite_Parse($$) { } } if ( int(@list) == 0 ) { - Log3 $name, 6, "S7_AWrite: Parse no client found ($name) ..."; + Log3 $name, 5, "S7_AWrite: Parse no client found ($name) ..."; push( @list, "" ); # return undef; @@ -468,96 +476,96 @@ sub S7_AWrite_Parse($$) { 1; =pod +=item summary logical device for a analog writing to a S7/S5 +=item summary_DE logisches Device für einen analogen Lese/Schreib Datenpunkt zu einer S5 / S7 + =begin html - +

    S7_AWrite

      - This module is a logical module of the physical module S7.
      - This module provides sending analog data (unsigned integer Values) to the PLC.
      - Note: you have to configure a PLC writing at the physical modul (S7) first.
      -
      - Define - -
        -
      • define <name> S7_AWrite {inputs|outputs|flags|db} <DB> <start> {u8|s8|u16|s16|u32|s32|float}
        -   -
          -
        • db … defines where to read. Note currently only writing in to DB are supported.
          • -
        • DB … Number of the DB
          • -
        • start … start byte of the reading
          • -
        • {u8|s8|u16|s16|u32|s32} … defines the datatype: -
            -
          • u8 …. unsigned 8 Bit integer
            • -
          • s8 …. signed 8 Bit integer
            • -
          • u16 …. unsigned 16 Bit integer
            • -
          • s16 …. signed 16 Bit integer
            • -
          • u32 …. unsigned 32 Bit integer
            • -
          • s32 …. signed 32 Bit integer
            • -
          • float …. 4 byte float
            • -
          -
          • -
        - Note: the required memory area (start – start + datatypelength) need to be with in the configured PLC writing of the physical module.
        • -
      - Set
      -   -
        -
      • set <name> S7_AWrite <value> - -
          -
        • value … an numeric value
          • -
        -
        • -
      +
        This module is a logical module of the physical module S7.
      +
    +
      +
        This module provides sending analog data (unsigned integer Values) to the PLC.
      +
    +
      +
        Note: you have to configure a PLC writing at the physical modul (S7) first.
      +
    +



    Define
    define <name> S7_AWrite {inputs|outputs|flags|db} <DB> <start> {u8|s8|u16|s16|u32|s32|float}

    +
      +
        +
          +
            +
          • db … defines where to read. Note currently only writing in to DB are supported.
            • +
          • DB … Number of the DB
            • +
          • start … start byte of the reading
            • +
          • {u8|s8|u16|s16|u32|s32} … defines the datatype:
            • +
              +
            • u8 …. unsigned 8 Bit integer
              • +
            • s8 …. signed 8 Bit integer
              • +
            • u16 …. unsigned 16 Bit integer
              • +
            • s16 …. signed 16 Bit integer
              • +
            • u32 …. unsigned 32 Bit integer
              • +
            • s32 …. signed 32 Bit integer
              • +
            • float …. 4 byte float
              • +
            +
          +Note: the required memory area (start – start + datatypelength) need to be with in the configured PLC writing of the physical module.
        +
      +
    +

    Set

    set <name> S7_AWrite <value>

    +
      +
        +
          +
        • value … an numeric value
          • +
        +
    =end html =begin html_DE - +

    S7_AWrite

      - This module is a logical module of the physical module S7.
      - This module provides sending analog data (unsigned integer Values) to the PLC.
      - Note: you have to configure a PLC writing at the physical modul (S7) first.
      -
      - Define - -
        -
      • define <name> S7_AWrite {inputs|outputs|flags|db} <DB> <start> {u8|s8|u16|s16|u32|s32|float}
        -   -
          -
        • db … defines where to read. Note currently only writing in to DB are supported.
          • -
        • DB … Number of the DB
          • -
        • start … start byte of the reading
          • -
        • {u8|s8|u16|s16|u32|s32} … defines the datatype: -
            -
          • u8 …. unsigned 8 Bit integer
            • -
          • s8 …. signed 8 Bit integer
            • -
          • u16 …. unsigned 16 Bit integer
            • -
          • s16 …. signed 16 Bit integer
            • -
          • u32 …. unsigned 32 Bit integer
            • -
          • s32 …. signed 32 Bit integer
            • -
          • float …. 4 byte float
            • -
          -
          • -
        - Note: the required memory area (start – start + datatypelength) need to be with in the configured PLC writing of the physical module.
        • -
      - Set
      -   -
        -
      • set <name> S7_AWrite <value> - -
          -
        • value … an numeric value
          • -
        -
        • -
      - +
        This module is a logical module of the physical module S7.
    - -=end html_DE +
      +
        This module provides sending analog data (unsigned integer Values) to the PLC.
      +
    +
      +
        Note: you have to configure a PLC writing at the physical modul (S7) first.
      +
    +



    Define
    define <name> S7_AWrite {inputs|outputs|flags|db} <DB> <start> {u8|s8|u16|s16|u32|s32|float}

    +
      +
        +
          +
            +
          • db … defines where to read. Note currently only writing in to DB are supported.
            • +
          • DB … Number of the DB
            • +
          • start … start byte of the reading
            • +
          • {u8|s8|u16|s16|u32|s32} … defines the datatype:
            • +
              +
            • u8 …. unsigned 8 Bit integer
              • +
            • s8 …. signed 8 Bit integer
              • +
            • u16 …. unsigned 16 Bit integer
              • +
            • s16 …. signed 16 Bit integer
              • +
            • u32 …. unsigned 32 Bit integer
              • +
            • s32 …. signed 32 Bit integer
              • +
            • float …. 4 byte float
              • +
            +
          +Note: the required memory area (start – start + datatypelength) need to be with in the configured PLC writing of the physical module.
        +
      +
    +

    Set

    set <name> S7_AWrite <value>

    +
      +
        +
          +
        • value … an numeric value
          • +
        +
      +
    =end html_DE =cut diff --git a/fhem/FHEM/44_S7_Client.pm b/fhem/FHEM/44_S7_Client.pm index c9315781c..cf6a3a4e0 100644 --- a/fhem/FHEM/44_S7_Client.pm +++ b/fhem/FHEM/44_S7_Client.pm @@ -7,84 +7,18 @@ require Exporter; use Config; use AutoLoader; -#use Socket; -use IO::Socket::INET; -use IO::Select; - -# vars in der main (*global*) -#use vars qw($Config); - -#doto - -#fehler in settimino: -#function :WriteArea & ReadArea -#bit shift opteratin in wrong direction -# PDU.H[23]=NumElements<<8; --> PDU.H[23]=NumElements>>8; -# PDU.H[24]=NumElements; - #todo fix timeout in ms our @ISA = qw(Exporter); - our %EXPORT_TAGS = ( 'all' => [ qw( - errTCPConnectionFailed - errTCPConnectionReset - errTCPDataRecvTout - errTCPDataSend - errTCPDataRecv - errISOConnectionFailed - errISONegotiatingPDU - errISOInvalidPDU - errS7InvalidPDU - errS7SendingPDU - errS7DataRead - errS7DataWrite - errS7Function - errBufferTooSmall - Code7Ok - Code7AddressOutOfRange - Code7InvalidTransportSize - Code7WriteDataSizeMismatch - Code7ResItemNotAvailable - Code7ResItemNotAvailable1 - Code7InvalidValue - Code7NeedPassword - Code7InvalidPassword - Code7NoPasswordToClear - Code7NoPasswordToSet - Code7FunNotAvailable - Code7DataOverPDU - S7_PG - S7_OP - S7_Basic - ISOSize - isotcp - MinPduSize - MaxPduSize - CC - S7Shift S7AreaPE S7AreaPA S7AreaMK S7AreaDB S7AreaCT S7AreaTM - S7WLBit - S7WLByte - S7WLWord - S7WLDWord - S7WLReal - S7WLCounter - S7WLTimer - S7CpuStatusUnknown - S7CpuStatusRun - S7CpuStatusStop - RxOffset - Size_RD - Size_WR - Size_DT ) ] ); @@ -92,119 +26,17 @@ our %EXPORT_TAGS = ( our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); our @EXPORT = qw( - errTCPConnectionFailed - errTCPConnectionReset - errTCPDataRecvTout - errTCPDataSend - errTCPDataRecv - errISOConnectionFailed - errISONegotiatingPDU - errISOInvalidPDU - errS7InvalidPDU - errS7SendingPDU - errS7DataRead - errS7DataWrite - errS7Function - errBufferTooSmall - Code7Ok - Code7AddressOutOfRange - Code7InvalidTransportSize - Code7WriteDataSizeMismatch - Code7ResItemNotAvailable - Code7ResItemNotAvailable1 - Code7InvalidValue - Code7NeedPassword - Code7InvalidPassword - Code7NoPasswordToClear - Code7NoPasswordToSet - Code7FunNotAvailable - Code7DataOverPDU - S7_PG - S7_OP - S7_Basic - ISOSize - isotcp - MinPduSize - MaxPduSize - CC - S7Shift S7AreaPE S7AreaPA S7AreaMK S7AreaDB S7AreaCT S7AreaTM - S7WLBit - S7WLByte - S7WLWord - S7WLDWord - S7WLReal - S7WLCounter - S7WLTimer - S7CpuStatusUnknown - S7CpuStatusRun - S7CpuStatusStop - RxOffset - Size_RD - Size_WR - Size_DT ); -package S7Client; -# Error Codes -# from 0x0001 up to 0x00FF are severe errors, the Client should be disconnected -# from 0x0100 are S7 Errors such as DB not found or address beyond the limit etc.. -# For Arduino Due the error code is a 32 bit integer but this doesn't change the constants use. - -use constant errTCPConnectionFailed => 0x0001; -use constant errTCPConnectionReset => 0x0002; -use constant errTCPDataRecvTout => 0x0003; -use constant errTCPDataSend => 0x0004; -use constant errTCPDataRecv => 0x0005; -use constant errISOConnectionFailed => 0x0006; -use constant errISONegotiatingPDU => 0x0007; -use constant errISOInvalidPDU => 0x0008; - -use constant errS7InvalidPDU => 0x0100; -use constant errS7SendingPDU => 0x0200; -use constant errS7DataRead => 0x0300; -use constant errS7DataWrite => 0x0400; -use constant errS7Function => 0x0500; - -use constant errBufferTooSmall => 0x0600; - -#CPU Errors - -# S7 outcoming Error code -use constant Code7Ok => 0x0000; -use constant Code7AddressOutOfRange => 0x0005; -use constant Code7InvalidTransportSize => 0x0006; -use constant Code7WriteDataSizeMismatch => 0x0007; -use constant Code7ResItemNotAvailable => 0x000A; -use constant Code7ResItemNotAvailable1 => 0xD209; -use constant Code7InvalidValue => 0xDC01; -use constant Code7NeedPassword => 0xD241; -use constant Code7InvalidPassword => 0xD602; -use constant Code7NoPasswordToClear => 0xD604; -use constant Code7NoPasswordToSet => 0xD605; -use constant Code7FunNotAvailable => 0x8104; -use constant Code7DataOverPDU => 0x8500; - -# Connection Type -use constant S7_PG => 0x01; -use constant S7_OP => 0x02; -use constant S7_Basic => 0x03; - -# ISO and PDU related constants -use constant ISOSize => 7; # Size of TPKT + COTP Header -use constant isotcp => 102; # ISOTCP Port -use constant MinPduSize => 16; # Minimum S7 valid telegram size -use constant MaxPduSize => - 247; # Maximum S7 valid telegram size (we negotiate 240 bytes + ISOSize) -use constant CC => 0xD0; # Connection confirm -use constant S7Shift => - 17; # We receive data 17 bytes above to align with PDU.DATA[] +#Base class for S7 and S5 Connections +package S7ClientBase; # S7 ID Area (Area that we want to read/write) use constant S7AreaPE => 0x81; @@ -214,144 +46,17 @@ use constant S7AreaDB => 0x84; use constant S7AreaCT => 0x1C; use constant S7AreaTM => 0x1D; -# WordLength -use constant S7WLBit => 0x01; -use constant S7WLByte => 0x02; -use constant S7WLChar => 0x03; -use constant S7WLWord => 0x04; -use constant S7WLInt => 0x05; -use constant S7WLDWord => 0x06; -use constant S7WLDInt => 0x07; -use constant S7WLReal => 0x08; -use constant S7WLCounter => 0x1C; -use constant S7WLTimer => 0x1D; - -# Result transport size -use constant TS_ResBit => 0x03; -use constant TS_ResByte => 0x04; -use constant TS_ResInt => 0x05; -use constant TS_ResReal => 0x07; -use constant TS_ResOctet => 0x09; - -use constant S7CpuStatusUnknown => 0x00; -use constant S7CpuStatusRun => 0x08; -use constant S7CpuStatusStop => 0x04; - -use constant RxOffset => 18; -use constant Size_DT => 25; -use constant Size_RD => 31; -use constant Size_WR => 35; sub new { my $class = shift; my $self = { - # Default TSAP values for connectiong as PG to a S7300 (Rack 0, Slot 2) - LocalTSAP_HI => 0x01, - LocalTSAP_LO => 0x00, - RemoteTSAP_HI => 0x01, - RemoteTSAP_LO => 0x02, - ConnType => &S7_PG, Connected => 0, # = false - LastError => 0, PDULength => 0, MaxReadLength => 0, RecvTimeout => 500, # 500 ms - LastPDUType => 0, - Peer => "", - ISO_CR => "", - S7_PN => "", - S7_RW => "", - PDU => {}, - cntword => 0, }; - #ISO Connection Request telegram (contains also ISO Header and COTP Header) - $self->{ISO_CR} = pack( - "C22", - - # TPKT (RFC1006 Header) - 0x03, # RFC 1006 ID (3) - 0x00, # Reserved, always 0 - 0x00 - , # High part of packet length (entire frame, payload and TPDU included) - 0x16 - , # Low part of packet length (entire frame, payload and TPDU included) - # COTP (ISO 8073 Header) - 0x11, # PDU Size Length - 0xE0, # CR - Connection Request ID - 0x00, # Dst Reference HI - 0x00, # Dst Reference LO - 0x00, # Src Reference HI - 0x01, # Src Reference LO - 0x00, # Class + Options Flags - 0xC0, # PDU Max Length ID - 0x01, # PDU Max Length HI - - 0x0A, # PDU Max Length LO # snap7 value Bytes 1024 - - # 0x09, # PDU Max Length LO # libnodave value Bytes 512 - - 0xC1, # Src TSAP Identifier - 0x02, # Src TSAP Length (2 bytes) - 0x01, # Src TSAP HI (will be overwritten by ISOConnect()) - 0x00, # Src TSAP LO (will be overwritten by ISOConnect()) - 0xC2, # Dst TSAP Identifier - 0x02, # Dst TSAP Length (2 bytes) - 0x01, # Dst TSAP HI (will be overwritten by ISOConnect()) - 0x02 # Dst TSAP LO (will be overwritten by ISOConnect()) - ); - - # S7 PDU Negotiation Telegram (contains also ISO Header and COTP Header) - $self->{S7_PN} = pack( - "C25", - 0x03, 0x00, 0x00, 0x19, 0x02, 0xf0, - 0x80, # TPKT + COTP (see above for info) - 0x32, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x08, 0x00, #snap7 trace - 0x00, 0xf0, 0x00, 0x00, 0x01, 0x00, 0x01, - - # 0x00, 0xf0 # PDU Length Requested = HI-LO 240 bytes - # 0x01, 0xe0 # PDU Length Requested = HI-LO 480 bytes - 0x03, 0xc0 # PDU Length Requested = HI-LO 960 bytes - ); - - # S7 Read/Write Request Header (contains also ISO Header and COTP Header) - $self->{S7_RW} = pack( - "C35", # 31-35 bytes - 0x03, 0x00, - 0x00, 0x1f, # Telegram Length (Data Size + 31 or 35) - 0x02, 0xf0, 0x80, # COTP (see above for info) - 0x32, # S7 Protocol ID - 0x01, # Job Type - 0x00, 0x00, # Redundancy identification (AB_EX) - 0x05, 0x00, # PDU Reference #snap7 (increment by every read/write) - 0x00, 0x0e, # Parameters Length - 0x00, 0x00, # Data Length = Size(bytes) + 4 - 0x04, # Function 4 Read Var, 5 Write Var - #reqest param head - 0x01, # Items count - 0x12, # Var spec. - 0x0a, # Length of remaining bytes - 0x10, # Syntax ID - &S7WLByte, # Transport Size - 0x00, 0x00, # Num Elements - 0x00, 0x00, # DB Number (if any, else 0) - 0x84, # Area Type - 0x00, 0x00, 0x00, # Area Offset - # WR area - 0x00, # Reserved - 0x04, # Transport size - 0x00, 0x00, # Data Length * 8 (if not timer or counter) - ); - - $self->{PDU}->{H} = pack( "C35", - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 ); - $self->{PDU}->{DATA} = ""; - - # print "New S7 Client created\n"; return bless $self, $class; } @@ -361,191 +66,12 @@ sub DESTROY { $self->Disconnect(); } -#----------------------------------------------------------------------------- -sub GetNextWord { - my $self = shift; - $self->{cntword} = 0 if ( $self->{cntword} == 0xFFFF ); - return $self->{cntword}++; -} - -#----------------------------------------------------------------------------- -sub SetLastError { - my ( $self, $Error ) = @_; - $self->{LastError} = $Error; - return $Error; -} - -#----------------------------------------------------------------------------- -#sub WaitForData_XXX { -# my ($self, $Size, $Timeout) = @_; -# my $BytesReady; - -# $Timeout = $Timeout / 1000; -## $Timeout = 1 if ($Timeout < 1); #deactivated in V2.9 -# -# -# my @ready = $self->{TCPClientSel}->can_read($Timeout); -# -# if (scalar(@ready)) { -# return $self->SetLastError(0); -# } -# -# # Here we are in timeout zone, if there's something into the buffer, it must be discarded. -# $self->Purge(); -# -# if (!$self->{TCPClient}->connected()) { -# return $self->SetLastError(&errTCPConnectionReset); -# } -# -# return $self->SetLastError(&errTCPDataRecvTout); -#} - -sub WaitForData { - my ( $self, $Size, $Timeout ) = @_; - my $BytesReady; - - $Timeout = $Timeout / 1000; - - # $Timeout = 1 if ($Timeout < 1); #deactivated in V2.9 - my @ready = $self->{TCPClientSel}->can_read($Timeout); - - if ( scalar(@ready) ) { - return $self->SetLastError(0); - } - -# Here we are in timeout zone, if there's something into the buffer, it must be discarded. - $self->{TCPClient}->flush(); - if ( !$self->{TCPClient}->connected() ) { - return $self->SetLastError(&errTCPConnectionReset); - } - - return $self->SetLastError(&errTCPDataRecvTout); -} - -#----------------------------------------------------------------------------- -sub IsoPduSize { - my ($self) = @_; - - my @buffer = unpack( "C" x 4, $self->{PDU}->{H} ); - my $Size = $buffer[2]; - return ( $Size << 8 ) + $buffer[3]; - -} - -#----------------------------------------------------------------------------- -sub RecvPacket { - my ( $self, $Size ) = @_; - my $buf; - - $self->WaitForData( $Size, $self->{RecvTimeout} ); - if ( $self->{LastError} != 0 ) { - - return $self->{LastError}; - } - - # - # recv($self->{TCPClient}, $buf, $Size , &MSG_NOSIGNAL); - # if (defined ($buf) && length($buf) == $Size ) - # { - # return ($self->SetLastError(0),$buf); - # } else { - # main::Log3 undef, 3,"TCPClient RecvPacket error (IP= ".$self->{Peer}.")."; - # return $self->SetLastError(&errTCPConnectionReset,$buf); - # } - - my $res = $self->{TCPClient}->recv( $buf, $Size ); - - if ( defined($buf) && length($buf) == $Size ) { - return ( $self->SetLastError(0), $buf ); - } - else { - - if ( defined($buf) ) { - - if ( $main::attr{global}{verbose} <= 3 ) { - my $b = join( ", ", unpack( "H2 " x length($buf), $buf ) ); - main::Log3 undef, 3, - "TCPClient RecvPacket error (IP= " - . $self->{Peer} . "): " - . $b; - } - } - else { - main::Log3 undef, 3, - "TCPClient RecvPacket error (IP= " . $self->{Peer} . ")."; - } - return $self->SetLastError( &errTCPConnectionReset, $buf ); - } - - # if ( !defined($res) ) #todo fix error handling for RecvPacket - # { - - # main::Log3 undef, 3,"TCPClient RecvPacket error."; - # # print "RecvPacket recv error, Size $Size, $buf \n"; - # return $self->SetLastError(&errTCPConnectionReset,$buf); - # } elsif ($res != 0) { - # main::Log3 undef, 3,"TCPClient RecvPacket error : $res"; - # return $self->SetLastError(&errTCPConnectionReset,$buf); - # } - # return ($self->SetLastError(0),$buf); - -} - -#----------------------------------------------------------------------------- -sub SetConnectionParams { - - my ( $self, $Address, $LocalTSAP, $RemoteTSAP ) = @_; - - $self->{Peer} = $Address; - $self->{LocalTSAP_HI} = $LocalTSAP >> 8; - $self->{LocalTSAP_LO} = $LocalTSAP & 0x00FF; - $self->{RemoteTSAP_HI} = $RemoteTSAP >> 8; - $self->{RemoteTSAP_LO} = $RemoteTSAP & 0x00FF; -} - -#----------------------------------------------------------------------------- -sub SetConnectionType { - my ( $self, $ConnectionType ) = @_; - - $self->{ConnType} = $ConnectionType; -} - -#----------------------------------------------------------------------------- -sub ConnectTo { - my ( $self, $Address, $Rack, $Slot ) = @_; - - $self->SetConnectionParams( $Address, 0x0100, - ( $self->{ConnType} << 8 ) + ( $Rack * 0x20 ) + $Slot ); - - return $self->Connect(); -} #----------------------------------------------------------------------------- sub Connect { my ($self) = @_; - $self->{LastError} = 0; - if ( !$self->{Connected} ) { - $self->TCPConnect(); - if ( $self->{LastError} == 0 ) # First stage : TCP Connection - { - $self->ISOConnect(); - if ( $self->{LastError} == - 0 ) # Second stage : ISOTCP (ISO 8073) Connection - { - $self->{LastError} = $self->NegotiatePduLength() - ; # Third stage : S7 PDU negotiation - } - } - } - - if ( $self->{LastError} == 0 ) { - $self->{Connected} = 1; - } - else { - $self->{Connected} = 0; - } - return $self->{LastError}; + return 0; } #----------------------------------------------------------------------------- @@ -553,20 +79,6 @@ sub Disconnect { my ($self) = @_; if ( $self->{Connected} ) { - $self->{TCPClientSel} = undef; - -# Purge() if (shutdown($self->{TCPClient}, &SD_SEND)==0);#Anmerkung SD_SEND = 1 -# close($self->{TCPClient}); - - if ( defined( $self->{TCPClient} ) ) { - my $res = shutdown( $self->{TCPClient}, 1 ); - if ( defined($res) ) { - $self->{TCPClient}->flush() if ( $res == 0 ); - } - $self->{TCPClient}->close(); - - $self->{TCPClient} = undef; - } $self->{Connected} = 0; $self->{PDULength} = 0; $self->{MaxReadLength} = 0; @@ -574,794 +86,18 @@ sub Disconnect { } } -#----------------------------------------------------------------------------- -sub TCPConnect { - my ($self) = @_; - - # # 1. create a socket handle (descriptor) - # my($sock); - # socket($sock, AF_INET, SOCK_STREAM, IPPROTO_TCP);#TCP_NODELAY, - # - # or die "ERROR in Socket Creation: $!"; - # - # # 2. connect to remote server - # my $remote = $self->{Peer}; - # - # my $iaddr = inet_aton($remote) or die "Unable to resolve hostname : $remote"; - # my $paddr = sockaddr_in(&isotcp, $iaddr); #socket address structure - # - # connect($sock , $paddr) or die "connect to $remote failed : $!"; - # $self->{TCPClient} = $sock; - # return $self->SetLastError(0); - # - # $self->{TCPClientSel} = new IO::Select($self->{TCPClient}); - - $self->{TCPClient} = new IO::Socket::INET( - PeerAddr => $self->{Peer}, - - # PeerHost => $self->{Peer}, - PeerPort => &isotcp, - Type => Socket::SOCK_STREAM, # probably needed on some systems - - Proto => 'tcp', - ) or die "ERROR in Socket Creation: $!"; - - $self->{TCPClient}->sockopt( &Socket::TCP_NODELAY, 1 ); - - $self->{TCPClient}->autoflush(1); - - $self->{TCPClientSel} = new IO::Select( $self->{TCPClient} ); - - return $self->SetLastError(0); - -} - -#----------------------------------------------------------------------------- - -sub RecvISOPacket { - - my ($self) = @_; - my $Size; - - my $Done = 0; - my $pdubuffer = ""; - my $res; - - $self->{LastError} = 0; - while ( ( $self->{LastError} == 0 ) && !$Done ) { - - # Get TPKT (4 bytes) - ( $res, $pdubuffer ) = $self->RecvPacket(4); - if ( $self->{LastError} == 0 ) { - - my $b = join( ", ", unpack( "H2 " x 4, $pdubuffer ) ); - - $self->{PDU}->{H} = $pdubuffer . substr( $self->{PDU}->{H}, 4 ); - $Size = $self->IsoPduSize(); - main::Log3 undef, 5, - "TCPClient RecvISOPacket Expected Size = $Size"; - - # Check 0 bytes Data Packet (only TPKT+COTP - 7 bytes) - if ( $Size == 7 ) { - $pdubuffer = ""; - ( $res, $pdubuffer ) = $self->RecvPacket(3); - - $self->{PDU}->{H} = $pdubuffer . substr( $self->{PDU}->{H}, 3 ); - - } - else { - my $maxlen = $self->{PDULength} + &ISOSize; - if ( $maxlen <= &MinPduSize ) { - $maxlen = &MaxPduSize; - } - - # if (($Size > &MaxPduSize) || ($Size < &MinPduSize)) { - if ( ( $Size > $maxlen ) || ( $Size < &MinPduSize ) ) { - main::Log3 undef, 3, - "TCPClient RecvISOPacket PDU overflow (IP= " - . $self->{Peer} - . "): size = $Size , maxPDULength = " - . $self->{PDULength}; - $self->{LastError} = &errISOInvalidPDU; - } - else { - $Done = 1; # a valid Length !=7 && >16 && <247 - } - } - } - } - if ( $self->{LastError} == 0 ) { - $pdubuffer = ""; - ( $res, $pdubuffer ) = $self->RecvPacket(3); - - $self->{PDU}->{H} = $pdubuffer - . substr( $self->{PDU}->{H}, 3 ); # Skip remaining 3 COTP bytes - - my @mypdu = unpack( "C2", $self->{PDU}->{H} ); - - $self->{LastPDUType} = $mypdu[1]; # Stores PDU Type, we need it - $Size -= &ISOSize; - - # We need to align with PDU.DATA - - $pdubuffer = ""; - ( $res, $pdubuffer ) = $self->RecvPacket($Size); - - if ( $main::attr{global}{verbose} <= 5 ) { - my $b = join( ", ", unpack( "H2 " x $Size, $pdubuffer ) ); - main::Log3 undef, 5, - "TCPClient RecvISOPacket (IP= " . $self->{Peer} . "): $b"; - } - - #we write the data starting at position 17 (shift) into the PDU.H - if ( $self->{LastError} == 0 ) { - - if ( $Size > &Size_WR - &S7Shift ) { - my $headerSize = &Size_WR - &S7Shift; - - $self->{PDU}->{H} = - substr( $self->{PDU}->{H}, 0, &S7Shift ) - . substr( $pdubuffer, 0, $headerSize ); - - $self->{PDU}->{DATA} = substr( $pdubuffer, $headerSize ); - - } - else { - - $self->{PDU}->{H} = - substr( $self->{PDU}->{H}, 0, &S7Shift ) - . $pdubuffer - . substr( $self->{PDU}->{H}, &Size_WR - &S7Shift - $Size ); - } - } - - } - if ( $self->{LastError} != 0 ) { - $self->{TCPClient}->flush(); - } - return ( $self->{LastError}, $Size ); -} - -#----------------------------------------------------------------------------- - -#sub Purge()#flushed tcpbuffer -#{ -# my ($self) = @_; -# # small buffer to empty the socket -# my $Trash; -# -# my $Read; -# -# if ($self->{LastError}!= WSAECONNRESET) -# { -# if (CanRead(0)) { -# do -# { -# recv($self->{TCPClient}, $Trash, 512, &MSG_NOSIGNAL ); -# } while( defined ($Trash) && length($Trash)==512); -# } -# } -#} - -#----------------------------------------------------------------------------- - -sub ISOConnect { - my ($self) = @_; - - my $Done = 0; - my $myLength = 0; - my $res; - - # Setup TSAPs - my @myISO_CR = unpack( "C22", $self->{ISO_CR} ); - $myISO_CR[16] = $self->{LocalTSAP_HI}; - $myISO_CR[17] = $self->{LocalTSAP_LO}; - $myISO_CR[20] = $self->{RemoteTSAP_HI}; - $myISO_CR[21] = $self->{RemoteTSAP_LO}; - $self->{ISO_CR} = pack( "C22", @myISO_CR ); - - my $b = join( ", ", unpack( "H2 " x 22, $self->{ISO_CR} ) ); - - if ( $self->{TCPClient}->send( $self->{ISO_CR} ) == 22 ) - - # if (send($self->{TCPClient}, $self->{ISO_CR}, &MSG_NOSIGNAL)==22) - { - ( $res, $myLength ) = $self->RecvISOPacket(); - - if ( ( $self->{LastError} == 0 ) - && ( $myLength == 15 ) - ) # 15 = 22 (sizeof CC telegram) - 7 (sizeof Header) - { - if ( $self->{LastPDUType} == &CC ) { #Connection confirm - return 0; - } - else { - return $self->SetLastError(&errISOInvalidPDU); - } - } - else { - return $self->{LastError}; - } - } - else { - return $self->SetLastError(&errISOConnectionFailed); - } -} - -#----------------------------------------------------------------------------- -sub NegotiatePduLength { - my ($self) = @_; - - my $myLength; - my $res; - - # Setup TSAPs - my @myS7_PN = unpack( "C25", $self->{S7_PN} ); - my $myPDUID = $self->GetNextWord(); - $myS7_PN[11] = $myPDUID % 256; - $myS7_PN[12] = ( $myPDUID >> 8 ) % 256; - $self->{S7_PN} = pack( "C25", @myS7_PN ); - - if ( $self->{TCPClient}->send( $self->{S7_PN} ) == 25 ) - - # if (send($self->{TCPClient}, $self->{S7_PN}, &MSG_NOSIGNAL)==25) - { - ( $res, $myLength ) = $self->RecvISOPacket(); - if ( $self->{LastError} == 0 ) { - - # check S7 Error - my @myPDUheader = unpack( "C35", $self->{PDU}->{H} ); - - if ( ( $myLength == 20 ) - && ( $myPDUheader[27] == 0 ) - && ( $myPDUheader[28] == 0 ) ) # 20 = size of Negotiate Answer - { - my @myPDUdata = unpack( "C2", $self->{PDU}->{DATA} ); - - $self->{PDULength} = $myPDUdata[0]; - $self->{PDULength} = - ( $self->{PDULength} << 8 ) + - $myPDUdata[1]; # Value negotiated - - $self->{MaxReadLength} = ( $self->{PDULength} - 18 ); - - if ( $self->{PDULength} > 0 ) { - return 0; - } - else { - return $self->SetLastError(&errISONegotiatingPDU); - } - } - else { - return $self->SetLastError(&errISONegotiatingPDU); - } - } - else { - return $self->{LastError}; - } - } - else { - return $self->SetLastError(&errISONegotiatingPDU); - } -} - -sub getPDULength() { - my ($self) = @_; - - if ( $self->{Connected} ) { - return $self->{PDULength}; - } - - return -1; -} #----------------------------------------------------------------------------- sub ReadArea () { - - my ( $self, $Area, $DBNumber, $Start, $Amount, $WordLen ) = @_; - - my $ptrData = ""; - - my $Address; - my $NumElements; - my $MaxElements; - my $TotElements; - my $SizeRequested; - my $myLength; - my $res; - - my $WordSize = 1; - - $self->{LastError} = 0; - - # If we are addressing Timers or counters the element size is 2 - $WordSize = 2 if ( ( $Area == &S7AreaCT ) || ( $Area == &S7AreaTM ) ); - - $MaxElements = - ( $self->{PDULength} - 18 ) / $WordSize; # 18 = Reply telegram header - $TotElements = $Amount; - - while ( ( $TotElements > 0 ) && ( $self->{LastError} == 0 ) ) { - $NumElements = $TotElements; - $NumElements = $MaxElements if ( $NumElements > $MaxElements ); - - $SizeRequested = $NumElements * $WordSize; - - # Setup the telegram - my @myPDU = - unpack( "C" x &Size_RD, substr( $self->{S7_RW}, 0, &Size_RD ) ); - - #my $b = join( ", ", unpack("H2 " x &Size_RD,$self->{S7_RW})); - # print "ReadArea: S7_RW :".$b."\n"; - - #set PDU Ref - my $myPDUID = $self->GetNextWord(); - $myPDU[11] = $myPDUID % 256; - $myPDU[12] = ( $myPDUID >> 8 ) % 256; - - $myPDU[20] = 0x0a; # Length of remaining bytes - $myPDU[21] = 0x10; # syntag ID - - # Set DB Number - $myPDU[27] = $Area; - if ( $Area == &S7AreaDB ) { - $myPDU[25] = ( $DBNumber >> 8 ) % 256; - $myPDU[26] = $DBNumber % 256; - } - else { - $myPDU[25] = 0x00; - $myPDU[26] = 0x00; - } - - # Adjusts Start - if ( ( $WordLen == &S7WLBit ) - || ( $WordLen == &S7WLCounter ) - || ( $WordLen == &S7WLTimer ) ) - { - $Address = $Start; - } - else { - $Address = $Start << 3; - } - - #set word length - $myPDU[22] = $WordLen; - - # Num elements - $myPDU[23] = ( $NumElements >> 8 ) - % 256; # hier ist denke ich ein fehler in der settimino.cpp - - $myPDU[24] = ($NumElements) % 256; - - # Address into the PLC - $myPDU[30] = ($Address) % 256; - $Address = $Address >> 8; - $myPDU[29] = ($Address) % 256; - $Address = $Address >> 8; - $myPDU[28] = ($Address) % 256; - - $self->{PDU}->{H} = - pack( "C" x &Size_RD, @myPDU ) - . substr( $self->{PDU}->{H}, &Size_RD ); - - if ( $main::attr{global}{verbose} <= 5 ) { - $b = join( ", ", unpack( "H2 " x &Size_RD, $self->{PDU}->{H} ) ); - main::Log3 undef, 5, - "TCPClient ReadArea (IP= " . $self->{Peer} . "): $b"; - } - - $b = substr( $self->{PDU}->{H}, 0, &Size_RD ); - if ( $self->{TCPClient}->send($b) == &Size_RD ) - { #Achtung PDU.H ist größer als &Size_RD - -# if (send($self->{TCPClient}, $b, &MSG_NOSIGNAL)== &Size_RD) #Achtung PDU.H ist größer als &Size_RD - - ( $res, $myLength ) = $self->RecvISOPacket(); - if ( $self->{LastError} == 0 ) { - if ( $myLength >= 18 ) { - - @myPDU = unpack( "C" x &Size_WR, $self->{PDU}->{H} ); - - if ( ( $myLength - 18 == $SizeRequested ) ) { - - #response was OK - $ptrData = - substr( $self->{PDU}->{DATA}, 0, $SizeRequested ) - ; # Copies in the user's buffer - } - else { # PLC reports an error - if ( $myPDU[31] == 0xFF ) { - - my $b = join( - ", ", - unpack( - "H2 " x $myLength, - $self->{PDU}->{H} . $self->{PDU}->{DATA} - ) - ); - main::Log3 undef, 3, - "TCPClient ReadArea error (IP= " - . $self->{Peer} - . ") returned data not expected size: $b"; - } - else { - my $b = join( - ", ", - unpack( - "H2 " x ( - length( $self->{PDU}->{H} ) + - length( $self->{PDU}->{DATA} ) - ), - $self->{PDU}->{H} . $self->{PDU}->{DATA} - ) - ); - main::Log3 undef, 3, - "TCPClient ReadArea error (IP= " - . $self->{Peer} - . ") returned data not OK: $b"; - } - $self->{LastError} = &errS7DataRead; - } - } - else { - $self->{LastError} = &errS7InvalidPDU; - } - } - } - else { - $self->{LastError} = &errTCPDataSend; - } - - $TotElements -= $NumElements; - $Start += $NumElements * $WordSize; - } - return ( $self->{LastError}, $ptrData ); } #----------------------------------------------------------------------------- sub WriteArea { - my ( $self, $Area, $DBNumber, $Start, $Amount, $WordLen, $ptrData ) = @_; - - my $Address; - my $NumElements; - my $MaxElements; - my $TotElements; - my $DataSize; - my $IsoSize; - my $myLength; - - my $Offset = 0; - my $WordSize = 1; - my $res; - - $self->{LastError} = 0; - - # If we are addressing Timers or counters the element size is 2 - $WordSize = 2 if ( ( $Area == &S7AreaCT ) || ( $Area == &S7AreaTM ) ); - - $MaxElements = - ( $self->{PDULength} - 35 ) / $WordSize; # 35 = Write telegram header - $TotElements = $Amount; - - while ( ( $TotElements > 0 ) && ( $self->{LastError} == 0 ) ) { - $NumElements = $TotElements; - if ( $NumElements > $MaxElements ) { - $NumElements = $MaxElements; - } - - #If we use the internal buffer only, we cannot exced the PDU limit - $DataSize = - $NumElements * $WordSize; #<------ Fehler Datasize sollte in Byte sein - $IsoSize = &Size_WR + $DataSize; - - # Setup the telegram - my @myPDU = - unpack( "C" x &Size_WR, substr( $self->{S7_RW}, 0, &Size_WR ) ); - - # Whole telegram Size - # PDU Length - $myPDU[2] = ( $IsoSize >> 8 ) % 256; - $myPDU[3] = $IsoSize % 256; - - #set PDU Ref - - my $myPDUID = $self->GetNextWord(); - $myPDU[11] = $myPDUID % 256; - $myPDU[12] = ( $myPDUID >> 8 ) % 256; - - # Data Length - $myLength = $DataSize + 4; - $myPDU[15] = ( $myLength >> 8 ) % 256; - $myPDU[16] = $myLength % 256; - - # Function - $myPDU[17] = 0x05; - - $myPDU[20] = 0x0a; # Length of remaining bytes - $myPDU[21] = 0x10; # syntag ID - - # Set DB Number - $myPDU[27] = $Area; - if ( $Area == &S7AreaDB ) { - $myPDU[25] = ( $DBNumber >> 8 ) % 256; - $myPDU[26] = $DBNumber % 256; - } - - # Adjusts Start - if ( ( $WordLen == &S7WLBit ) - || ( $WordLen == &S7WLCounter ) - || ( $WordLen == &S7WLTimer ) ) - { - $Address = $Start; - } - else { - $Address = $Start << 3; - } - - # Address into the PLC - $myPDU[30] = $Address % 256; - $Address = $Address >> 8; - $myPDU[29] = $Address % 256; - $Address = $Address >> 8; - $myPDU[28] = $Address % 256; - - #transport size - my $bytesProElement; - - if ( $WordLen == &S7WLBit ) { - $myPDU[32] = &TS_ResBit; - $bytesProElement = 1; - } - - # elsif ($WordLen == &S7WLWord) { #V2.8 will be send as Bytes! - # $myPDU[32] = &TS_ResInt; - # $bytesProElement = 2; - # } - # elsif ($WordLen == &S7WLDWord) { - # $myPDU[32] = &TS_ResInt; - # $bytesProElement = 4; - # } - elsif ( $WordLen == &S7WLInt ) { - $myPDU[32] = &TS_ResInt; - $bytesProElement = 2; - } - elsif ( $WordLen == &S7WLDInt ) { - $myPDU[32] = &TS_ResInt; - $bytesProElement = 4; - } - elsif ( $WordLen == &S7WLReal ) { - $myPDU[32] = &TS_ResReal; - $bytesProElement = 4; - } - elsif ( $WordLen == &S7WLChar ) { - $myPDU[32] = &TS_ResOctet; - $bytesProElement = 1; - } - elsif ( $WordLen == &S7WLCounter ) { - $myPDU[32] = &TS_ResOctet; - $bytesProElement = 2; - } - elsif ( $WordLen == &S7WLTimer ) { - $myPDU[32] = &TS_ResOctet; - $bytesProElement = 2; - } - else { - $myPDU[32] = &TS_ResByte; - $bytesProElement = 1; - } - - if ( ( $myPDU[32] != &TS_ResOctet ) - && ( $myPDU[32] != &TS_ResReal ) - && ( $myPDU[32] != &TS_ResBit ) ) - { - $myLength = $DataSize << 3; - - } - else { - $myLength = $DataSize; - } - - # Num elements - my $nElements = int( $NumElements / $bytesProElement ); - $myPDU[23] = ( $nElements >> 8 ) % 256; - $myPDU[24] = ($nElements) % 256; - - #set word length - $myPDU[22] = $WordLen; - - # Length - $myPDU[33] = ( $myLength >> 8 ) % 256; - $myPDU[34] = $myLength % 256; - $self->{PDU}->{H} = pack( "C" x &Size_WR, @myPDU ); - - # Copy data - $self->{PDU}->{DATA} = substr( $ptrData, $Offset, $DataSize ); - - if ( $main::attr{global}{verbose} <= 5 ) { - my $b = join( - ", ", - unpack( - "H2 " x $IsoSize, - $self->{PDU}->{H} . $self->{PDU}->{DATA} - ) - ); - main::Log3 undef, 5, - "TCPClient WriteArea (IP= " . $self->{Peer} . "): $b"; - } - if ( - $self->{TCPClient}->send( $self->{PDU}->{H} . $self->{PDU}->{DATA} ) - == $IsoSize ) - { - -# if (send($self->{TCPClient}, $self->{PDU}->{H}.$self->{PDU}->{DATA}, &MSG_NOSIGNAL)== $IsoSize) - ( $res, $myLength ) = $self->RecvISOPacket(); - if ( $self->{LastError} == 0 ) { - - if ( $myLength == 15 ) { - @myPDU = unpack( "C" x &Size_WR, $self->{PDU}->{H} ); - - if ( ( $myPDU[27] != 0x00 ) - || ( $myPDU[28] != 0x00 ) - || ( $myPDU[31] != 0xFF ) ) - { - $self->{LastError} = &errS7DataWrite; - - #CPU has sent an Error? - my $cpuErrorCode = $myPDU[31]; - my $error = $self->getCPUErrorStr($cpuErrorCode); - - my $msg = - "TCPClient WriteArea error: $cpuErrorCode = $error"; - main::Log3 undef, 3, $msg; - - } - - } - else { - $self->{LastError} = &errS7InvalidPDU; - } - } - } - else { - $self->{LastError} = &errTCPDataSend; - } - - $Offset += $DataSize; - $TotElements -= $NumElements; - $Start += $NumElements * $WordSize; - } - return $self->{LastError}; } #----------------------------------------------------------------------------- sub getPLCDateTime() { - my ($self) = @_; - my $IsoSize; - my $res; - my $TotElements; - - main::Log3 undef, 3, "TCPClient getPLCDateTime:"; - - # Setup the telegram - my @myPDU = unpack( "C" x &Size_DT, substr( $self->{S7_RW}, 0, &Size_DT ) ); - - # Whole telegram Size - # PDU Length - $IsoSize = &Size_DT; - - $myPDU[2] = ( $IsoSize >> 8 ) % 256; - $myPDU[3] = $IsoSize % 256; - - $myPDU[8] = 0x07; #job type = userdata - - $myPDU[9] = 0x00; # Redundancy identification - $myPDU[10] = 0x00; - - #set PDU Ref - my $myPDUID = $self->GetNextWord(); - $myPDU[11] = ( $myPDUID >> 8 ) % 256; - $myPDU[12] = $myPDUID % 256; - - #parameter length - $myPDU[13] = 0x00; - $myPDU[14] = 0x08; - - # Data Length - my $myLength = 4; - $myPDU[15] = ( $myLength >> 8 ) % 256; - $myPDU[16] = $myLength % 256; - - # Function - $myPDU[17] = 0x04; #read - - #set parameter heads - $myPDU[18] = 0x01; # Items count - $myPDU[19] = 0x12; # Var spec. - $myPDU[20] = 0x04; # Length of remaining bytes - $myPDU[21] = 0x11; # uk - $myPDU[22] = 0x47; # tg = grClock - $myPDU[23] = 0x01; #subfunction: Read Clock (Date and Time) - $myPDU[24] = 0x00; #Seq - - $self->{PDU}->{H} = - pack( "C" x &Size_DT, @myPDU ) . substr( $self->{PDU}->{H}, &Size_DT ); - - my $b = join( ", ", unpack( "H2 " x &Size_DT, $self->{PDU}->{H} ) ); - main::Log3 undef, 3, - "TCPClient getPLCDateTime (IP= " . $self->{Peer} . "): $b"; - - $b = substr( $self->{PDU}->{H}, 0, &Size_DT ); - if ( $self->{TCPClient}->send($b) == &Size_DT ) { - - # main::Log3 undef, 3,"TCPClient getPLCDateTime request sent"; - ( $res, $myLength ) = $self->RecvISOPacket(); - main::Log3 undef, 3, "TCPClient getPLCDateTime RecvISOPacket $res"; - if ( $self->{LastError} == 0 ) { - if ( $myLength >= 18 ) { - - @myPDU = unpack( "C" x $myLength, $self->{PDU}->{H} ); - my $b = join( - ", ", - unpack( - "H2 " x $myLength, - $self->{PDU}->{H} . $self->{PDU}->{DATA} - ) - ); - main::Log3 undef, 3, - "TCPClient getPLCDateTime getPLCTime Result (IP= " - . $self->{Peer} . "): $b"; - - } - else { - $self->{LastError} = &errS7InvalidPDU; - main::Log3 undef, 3, - "TCPClient getPLCDateTime errS7InvalidPDU length $myLength"; - - } - } - } - else { - $self->{LastError} = &errTCPDataSend; - main::Log3 undef, 3, "TCPClient getPLCDateTime errTCPDataSend"; - } - - # $TotElements -= $NumElements; - # $Start += $NumElements * $WordSize; - # } - # return ($self->{LastError},$ptrData); - return ( $self->{LastError}, 0 ); - -# IsoSize=sizeof(TS7ReqHeader)+sizeof(TReqFunDateTime)+sizeof(TReqDataGetDateTime); -# Result=isoExchangeBuffer(0,IsoSize); - - # Get Data - # if (Result==0) - # { - # if (ResParams->Err==0) - # { - # if (ResData->RetVal==0xFF) // <-- 0xFF means Result OK - # { - # // Decode Plc Date and Time - # AYear=BCDtoByte(ResData->Time[0]); - # if (AYear<90) - # AYear=AYear+100; - # DateTime->tm_year=AYear; - # DateTime->tm_mon =BCDtoByte(ResData->Time[1])-1; - # DateTime->tm_mday=BCDtoByte(ResData->Time[2]); - # DateTime->tm_hour=BCDtoByte(ResData->Time[3]); - # DateTime->tm_min =BCDtoByte(ResData->Time[4]); - # DateTime->tm_sec =BCDtoByte(ResData->Time[5]); - # DateTime->tm_wday=(ResData->Time[7] & 0x0F)-1; - # } - # else - # Result=CpuError(ResData->RetVal); - # } - # else - # Result=CpuError(ResData->RetVal); - # } - # return Result; - # } #----------------------------------------------------------------------------- @@ -1686,110 +422,35 @@ sub PutFloatAt { #----------------------------------------------------------------------------- sub version { - return "1.0"; + return "1.1"; } #----------------------------------------------------------------------------- sub getErrorStr { - my ( $self, $errorCode ) = @_; - if ( $errorCode == &errTCPConnectionFailed ) { - return "TCP Connection error"; - } - elsif ( $errorCode == &errTCPConnectionReset ) { - return "Connection reset by the peer"; - } - elsif ( $errorCode == &errTCPDataRecvTout ) { - return "A timeout occurred waiting a reply."; - } - elsif ( $errorCode == &errTCPDataSend ) { - return "Ethernet driver returned an error sending the data"; - } - elsif ( $errorCode == &errTCPDataRecv ) { - return "Ethernet driver returned an error receiving the data."; - } - elsif ( $errorCode == &errISOConnectionFailed ) { - return "ISO connection failed."; - } - elsif ( $errorCode == &errISONegotiatingPDU ) { - return "ISO PDU negotiation failed"; - } - elsif ( $errorCode == &errISOInvalidPDU ) { - return "Malformed PDU supplied."; - } - elsif ( $errorCode == &errS7InvalidPDU ) { return "Invalid PDU received."; } - elsif ( $errorCode == &errS7SendingPDU ) { return "Error sending a PDU."; } - elsif ( $errorCode == &errS7DataRead ) { return "Error during data read"; } - elsif ( $errorCode == &errS7DataWrite ) { - return "Error during data write"; - } - elsif ( $errorCode == &errS7Function ) { - return "The PLC reported an error for this function."; - } - elsif ( $errorCode == &errBufferTooSmall ) { - return "The buffer supplied is too small."; - } - else { return "unknown errorcode"; } - -} - -sub getCPUErrorStr { - my ( $self, $errorCode ) = @_; - - if ( $errorCode == &Code7Ok ) { return "CPU: OK"; } - elsif ( $errorCode == &Code7AddressOutOfRange ) { - return "CPU: AddressOutOfRange"; - } - elsif ( $errorCode == &Code7InvalidTransportSize ) { - return "CPU: Invalid Transport Size"; - } - elsif ( $errorCode == &Code7WriteDataSizeMismatch ) { - return "CPU: Write Data Size Mismatch"; - } - elsif ( $errorCode == &Code7ResItemNotAvailable ) { - return "CPU: ResItem Not Available"; - } - elsif ( $errorCode == &Code7ResItemNotAvailable1 ) { - return "CPU: ResItem Not Available1"; - } - elsif ( $errorCode == &Code7InvalidValue ) { return "CPU: Invalid Value"; } - elsif ( $errorCode == &Code7NeedPassword ) { return "CPU: Need Password"; } - elsif ( $errorCode == &Code7InvalidPassword ) { - return "CPU: Invalid Password"; - } - elsif ( $errorCode == &Code7NoPasswordToClear ) { - return "CPU: No Password To Clear"; - } - elsif ( $errorCode == &Code7NoPasswordToSet ) { - return "CPU: No Password To Set"; - } - elsif ( $errorCode == &Code7FunNotAvailable ) { - return "CPU: Fun Not Available"; - } - elsif ( $errorCode == &Code7DataOverPDU ) { return "CPU: DataOverPDU"; } - else { return "unknown errorcode"; } } 1; + =pod +=item summary abstract interface layer S7 / S5 +=item summary_DE abstract interface layer S7 / S5 =begin html - +

    S7_Client

      - part of the S7 modul +
        abstract interface layer S7 / S5
    =end html - =begin html_DE - +

    S7_Client

      - part of the S7 modul +
        abstract interface layer S7 / S5
    - =end html_DE -=cut +=cut \ No newline at end of file diff --git a/fhem/FHEM/44_S7_DRead.pm b/fhem/FHEM/44_S7_DRead.pm index 5ceae389c..57ab4cc79 100644 --- a/fhem/FHEM/44_S7_DRead.pm +++ b/fhem/FHEM/44_S7_DRead.pm @@ -56,10 +56,11 @@ sub S7_DRead_Define($$) { if ( uc $a[2] =~ m/^Q(\d*)/ ) { $startposition = 1; - if ( $hash->{IODev}{S7TYPE} eq "LOGO7" ) { + + if ( defined($hash->{IODev}{S7TYPE}) && $hash->{IODev}{S7TYPE} eq "LOGO7" ) { $Offset = 942; } - elsif ( $hash->{IODev}{S7TYPE} eq "LOGO8" ) { + elsif ( defined($hash->{IODev}{S7TYPE}) && $hash->{IODev}{S7TYPE} eq "LOGO8" ) { $Offset = 1064; } else { @@ -263,7 +264,7 @@ sub S7_DRead_Parse_new($$) { #aktualisierung des wertes my $s = int( $h->{POSITION} / 8 ) - $start; - my $myI = $hash->{S7TCPClient}->ByteAt( \@Writebuffer, $s ); + my $myI = $hash->{S7PLCClient}->ByteAt( \@Writebuffer, $s ); Log3 $name, 6, "$name S7_DRead_Parse update $n "; @@ -346,7 +347,7 @@ sub S7_DRead_Parse($$) { #aktualisierung des wertes my $s = int( $h->{POSITION} / 8 ) - $start; - my $myI = $hash->{S7TCPClient}->ByteAt( \@Writebuffer, $s ); + my $myI = $hash->{S7PLCClient}->ByteAt( \@Writebuffer, $s ); Log3 $name, 6, "$name S7_DRead_Parse update $clientName "; @@ -390,7 +391,7 @@ sub S7_DRead_Parse($$) { #my $b = pack( "C" x $length, @Writebuffer ); my $myI = - $hash->{S7TCPClient}->ByteAt( \@Writebuffer, $s ); + $hash->{S7PLCClient}->ByteAt( \@Writebuffer, $s ); Log3 $name, 6, "$name S7_DRead_Parse update $n "; @@ -452,30 +453,30 @@ sub S7_DRead_Attr(@) { 1; =pod +=item summary logical device for a digital reading from a S7/S5 +=item summary_DE logisches Device für einen binären Nur Lese Datenpunkt von einer S5 / S7 =begin html

    S7_DRead

      - This module is a logical module of the physical module S7.
      - This module provides digital data (ON/OFF).
      - Note: you have to configure a PLC reading at the physical modul (S7) first.
      -
      -
      - Define +This module is a logical module of the physical module S7.
      +This module provides digital data (ON/OFF).
      +Note: you have to configure a PLC reading at the physical modul (S7) first.
      +

      +Define +
        +define <name> S7_DRead {inputs|outputs|flags|db} <DB> <address> -
          -
        • define <name> S7_DRead {inputs|outputs|flags|db} <DB> <address> - -
            -
          • inputs|outputs|flags|db … defines where to read.
            • -
          • DB … Number of the DB
            • -
          • address … address you want to read. bit number to read. Example: 10.3
            • -
          - Note: the required memory area need to be with in the configured PLC reading of the physical module.
          • -
        +
          +
        • inputs|outputs|flags|db … defines where to read.
          • +
        • DB … Number of the DB
          • +
        • address … address you want to read. bit number to read. Example: 10.3
          • +
        +Note: the required memory area need to be with in the configured PLC reading of the physical module.
      +
    =end html =begin html_DE @@ -483,26 +484,23 @@ sub S7_DRead_Attr(@) {

    S7_DRead

      - This module is a logical module of the physical module S7.
      - This module provides digital data (ON/OFF).
      - Note: you have to configure a PLC reading at the physical modul (S7) first.
      -
      -
      - Define -
        -
      • define <name> S7_DRead {inputs|outputs|flags|db} <DB> <address> +This module is a logical module of the physical module S7.
        +This module provides digital data (ON/OFF).
        +Note: you have to configure a PLC reading at the physical modul (S7) first.
        +

        +Define +
          +define <name> S7_DRead {inputs|outputs|flags|db} <DB> <address> -
            -
          • inputs|outputs|flags|db … defines where to read.
            • -
          • DB … Number of the DB
            • -
          • address … address you want to read. bit number to read. Example: 10.3
            • -
          - Note: the required memory area need to be with in the configured PLC reading of the physical module. -
        +
          +
        • inputs|outputs|flags|db … defines where to read.
          • +
        • DB … Number of the DB
          • +
        • address … address you want to read. bit number to read. Example: 10.3
          • +
        +Note: the required memory area need to be with in the configured PLC reading of the physical module. +
    - =end html_DE -=cut - +=cut \ No newline at end of file diff --git a/fhem/FHEM/44_S7_DWrite.pm b/fhem/FHEM/44_S7_DWrite.pm index fa1ba7f15..100f3e695 100644 --- a/fhem/FHEM/44_S7_DWrite.pm +++ b/fhem/FHEM/44_S7_DWrite.pm @@ -196,6 +196,7 @@ sub S7_DWrite_Define($$) { } $position = ( $byte * 8 ) + $bit; } + Log3 $name, 5, "S7_DWrite_Define called2"; $hash->{ADDRESS} = "$byte.$bit"; @@ -243,303 +244,347 @@ sub S7_DWrite_setABit($$) { return $writeAreaIndex if ( $writeAreaIndex ne int($writeAreaIndex) ); my $b = 0; + my $res; if ( $newValue eq "on" || $newValue eq "trigger" ) { $b = 1; } + if ( $shash->{S7TYPE} eq "S5" ) { - my $res = S7_WriteBitToPLC( $shash, $writeAreaIndex, $dbNR, $position, $b ); + #S5 + #lesen wir das aktuelle byte + my $byte = int( $position / 8 ); + my $bit = int( $position % 8 ); + my $readbuffer; + ( $res, $readbuffer ) = + S7_ReadBlockFromPLC( $shash, $writeAreaIndex, $dbNR, $byte, 1 ); - if ( $res == 0 ) { - main::readingsSingleUpdate( $hash, "state", $newValue, 1 ); - } - else { - main::readingsSingleUpdate( $hash, "state", "", 1 ); - } + if ( $res == 0 && length($readbuffer) == 1 ) { #reading was OK + #setzen/löschen wir das gewünsche bit + + my $tbuffer = join( ", ", unpack( "H2 " x length($readbuffer), $readbuffer ) ); + Log3( undef, 5, "S5 Read old Value <-- " . $tbuffer ." now changing bitNr: ".$bit ); + + + my @cbuffer = unpack( "C" x length($readbuffer), $readbuffer); + if ($b == 1) { + $cbuffer[0] |= (1 << $bit); + } else { + $cbuffer[0] &= (~(1 << $bit)) & 0xFF; + } + + $readbuffer = pack( "C" x 1, @cbuffer); + - if ( $newValue eq "trigger" ) { + #schreiben wir das byte + $tbuffer = join( ", ", unpack( "H2 " x length($readbuffer), $readbuffer ) ); + Log3( undef, 5, "S5 Write new Value <-- " . $tbuffer ); + $res = S7_WriteToPLC( $shash, $writeAreaIndex, $dbNR, $byte, &S7Client::S7WLByte , $readbuffer ); + + - my $triggerLength = 1; - if ( defined( $main::attr{$name}{trigger_length} ) ) { - $triggerLength = $main::attr{$name}{trigger_length}; - } - InternalTimer( gettimeofday() + $triggerLength, - "S7_DWrite_SwitchOff", $hash, 1 ); - } + if ( $res != 0 ) { + my $error = $shash->{S7PLCClient}->getErrorStr($res); + my $msg = + "$name S7_DWrite_setABit -S5- S7_WriteToPLC error: $res=$error"; + Log3( $name, 3, $msg ); + } + + + } else { - return undef; + my $error = $shash->{S7PLCClient}->getErrorStr($res); + my $msg = + "$name S7_DWrite_setABit -S5- ReadArea error: $res=$error"; + Log3( $name, 3, $msg ); -} - -##################################### - -sub S7_DWrite_Set(@) { - my ( $hash, @a ) = @_; - - return "Need at least one parameter" if ( int(@a) < 2 ); - return S7_DWrite_setABit( $hash, $a[1] ); - -} - -##################################### - -sub S7_DWrite_SwitchOff($) { - my ($hash) = @_; - my $name = $hash->{NAME}; - Log3 $name, 4, "S7_DWrite: GetUpdate called ..."; - - return S7_DWrite_setABit( $hash, "off" ); - -} - -##################################### - -sub S7_DWrite_Parse($$) { - my ( $hash, $rmsg ) = @_; - my $name; - - if ( defined( $hash->{NAME} ) ) { - $name = $hash->{NAME}; - } - else { - $name = "dummy"; - Log3 undef, 2, "S7_DWrite_Parse: Error ..."; - return undef; - } - - my @a = split( "[ \t][ \t]*", $rmsg ); - my @list; - - my ( $area, $DB, $start, $length, $datatype, $s7name, $hexbuffer, - $clientNames ); - - $area = lc $a[1]; - $DB = $a[2]; - $start = $a[3]; - $length = $a[4]; - $s7name = $a[5]; - $hexbuffer = $a[6]; - $clientNames = $a[7]; - - my $ID = "$area $DB"; - - Log3 $name, 6, "$name S7_DWrite_Parse $rmsg"; - my @clientList = split( ",", $clientNames ); - - if ( int(@clientList) > 0 ) { - my @Writebuffer = unpack( "C" x $length, - pack( "H2" x $length, split( ",", $hexbuffer ) ) ); -# my $b = pack( "C" x $length, @Writebuffer ); - foreach my $clientName (@clientList) { - - my $h = $defs{$clientName}; - - # if ( defined( $main::attr{ $h->{NAME} }{IODev} ) - # && $main::attr{ $h->{NAME} }{IODev} eq $name ) - # { - - if ( $h->{TYPE} eq "S7_DWrite" - && $start <= int( $h->{POSITION} / 8 ) - && $start + $length >= int( $h->{POSITION} / 8 ) ) - { - push( @list, $clientName ) - ; #damit die werte im client gesetzt werden! - - #aktualisierung des wertes - my $s = int( $h->{POSITION} / 8 ) - $start; - - my $myI = $hash->{S7TCPClient}->ByteAt( \@Writebuffer, $s ); - - Log3 $name, 5, "$name S7_DWrite_Parse update $clientName "; - - if ( ( int($myI) & ( 1 << ( $h->{POSITION} % 8 ) ) ) > 0 ) { - - main::readingsSingleUpdate( $h, "state", "on", 1 ); - - } - else { - main::readingsSingleUpdate( $h, "state", "off", 1 ); - - } + S7_reconnect($shash); #lets try a reconnect + return ( -2, $msg ); } - # } } + else { + + #S7 + $res = + S7_WriteBitToPLC( $shash, $writeAreaIndex, $dbNR, $position, $b ); + } + + if ( $res == 0 ) { + main::readingsSingleUpdate( $hash, "state", $newValue, 1 ); + } + else { + main::readingsSingleUpdate( $hash, "state", "", 1 ); + } + + if ( $newValue eq "trigger" ) { + + my $triggerLength = 1; + if ( defined( $main::attr{$name}{trigger_length} ) ) { + $triggerLength = $main::attr{$name}{trigger_length}; + } + + InternalTimer( gettimeofday() + $triggerLength, + "S7_DWrite_SwitchOff", $hash, 1 ); + } + + return undef; + } - else { - Log3 $name, 3, "$name S7_DWrite_Parse going the save way "; - if ( defined( $modules{S7_DWrite}{defptr}{$ID} ) ) { +##################################### - foreach my $h ( @{ $modules{S7_DWrite}{defptr}{$ID} } ) { - if ( defined( $main::attr{ $h->{NAME} }{IODev} ) - && $main::attr{ $h->{NAME} }{IODev} eq $name ) + sub S7_DWrite_Set(@) { + my ( $hash, @a ) = @_; + + return "Need at least one parameter" if ( int(@a) < 2 ); + return S7_DWrite_setABit( $hash, $a[1] ); + + } + +##################################### + + sub S7_DWrite_SwitchOff($) { + my ($hash) = @_; + my $name = $hash->{NAME}; + Log3 $name, 4, "S7_DWrite: GetUpdate called ..."; + + return S7_DWrite_setABit( $hash, "off" ); + + } + +##################################### + + sub S7_DWrite_Parse($$) { + my ( $hash, $rmsg ) = @_; + my $name; + + if ( defined( $hash->{NAME} ) ) { + $name = $hash->{NAME}; + } + else { + $name = "dummy"; + Log3 undef, 2, "S7_DWrite_Parse: Error ..."; + return undef; + } + + my @a = split( "[ \t][ \t]*", $rmsg ); + my @list; + + my ( $area, $DB, $start, $length, $datatype, $s7name, $hexbuffer, + $clientNames ); + + $area = lc $a[1]; + $DB = $a[2]; + $start = $a[3]; + $length = $a[4]; + $s7name = $a[5]; + $hexbuffer = $a[6]; + $clientNames = $a[7]; + + my $ID = "$area $DB"; + + Log3 $name, 6, "$name S7_DWrite_Parse $rmsg"; + my @clientList = split( ",", $clientNames ); + + if ( int(@clientList) > 0 ) { + my @Writebuffer = unpack( "C" x $length, + pack( "H2" x $length, split( ",", $hexbuffer ) ) ); + foreach my $clientName (@clientList) { + + my $h = $defs{$clientName}; + + if ( $h->{TYPE} eq "S7_DWrite" + && $start <= int( $h->{POSITION} / 8 ) + && $start + $length >= int( $h->{POSITION} / 8 ) ) { - if ( $start <= int( $h->{POSITION} / 8 ) - && $start + $length >= int( $h->{POSITION} / 8 ) ) - { + push( @list, $clientName ) + ; #damit die werte im client gesetzt werden! - my $n = - $h->{NAME}; #damit die werte im client gesetzt werden! - push( @list, $n ); + #aktualisierung des wertes + my $s = int( $h->{POSITION} / 8 ) - $start; - #aktualisierung des wertes - my @Writebuffer = unpack( "C" x $length, - pack( "H2" x $length, split( ",", $hexbuffer ) ) ); - my $s = int( $h->{POSITION} / 8 ) - $start; -# my $b = pack( "C" x $length, @Writebuffer ); + my $myI = $hash->{S7PLCClient}->ByteAt( \@Writebuffer, $s ); - my $myI = $hash->{S7TCPClient}->ByteAt(\@Writebuffer, $s ); + Log3 $name, 5, "$name S7_DWrite_Parse update $clientName "; - Log3 $name, 6, "$name S7_DWrite_Parse update $n "; + if ( ( int($myI) & ( 1 << ( $h->{POSITION} % 8 ) ) ) > 0 ) { - if ( ( int($myI) & ( 1 << ( $h->{POSITION} % 8 ) ) ) > - 0 ) - { + main::readingsSingleUpdate( $h, "state", "on", 1 ); - main::readingsSingleUpdate( $h, "state", "on", 1 ); + } + else { + main::readingsSingleUpdate( $h, "state", "off", 1 ); - } - else { - - main::readingsSingleUpdate( $h, "state", "off", 1 ); - - } } } + # } } } + else { + Log3 $name, 3, "$name S7_DWrite_Parse going the save way "; + + if ( defined( $modules{S7_DWrite}{defptr}{$ID} ) ) { + + foreach my $h ( @{ $modules{S7_DWrite}{defptr}{$ID} } ) { + if ( defined( $main::attr{ $h->{NAME} }{IODev} ) + && $main::attr{ $h->{NAME} }{IODev} eq $name ) + { + if ( $start <= int( $h->{POSITION} / 8 ) + && $start + $length >= int( $h->{POSITION} / 8 ) ) + { + + my $n = $h + ->{NAME}; #damit die werte im client gesetzt werden! + push( @list, $n ); + + #aktualisierung des wertes + my @Writebuffer = unpack( + "C" x $length, + pack( + "H2" x $length, split( ",", $hexbuffer ) + ) + ); + my $s = int( $h->{POSITION} / 8 ) - $start; + + # my $b = pack( "C" x $length, @Writebuffer ); + + my $myI = + $hash->{S7PLCClient}->ByteAt( \@Writebuffer, $s ); + + Log3 $name, 6, "$name S7_DWrite_Parse update $n "; + + if ( ( int($myI) & ( 1 << ( $h->{POSITION} % 8 ) ) ) + > 0 ) + { + + main::readingsSingleUpdate( $h, "state", "on", + 1 ); + + } + else { + + main::readingsSingleUpdate( $h, "state", "off", + 1 ); + + } + } + } + + } + } + } + + if ( int(@list) == 0 ) { + Log3 $name, 6, "S7_DWrite: Parse no client found ($name) ..."; + push( @list, "" ); + } + + return @list; + } - - if ( int(@list) == 0 ) { - Log3 $name, 6, "S7_DWrite: Parse no client found ($name) ..."; - push( @list, "" ); - } - - return @list; - -} ##################################### -sub S7_DWrite_Attr(@) { - my ( $cmd, $name, $aName, $aVal ) = @_; + sub S7_DWrite_Attr(@) { + my ( $cmd, $name, $aName, $aVal ) = @_; - # $cmd can be "del" or "set" - # $name is device name - # aName and aVal are Attribute name and value - my $hash = $defs{$name}; - if ( $cmd eq "set" ) { - if ( $aName eq "trigger_length" ) { - if ( $aVal ne int($aVal) ) { - Log3 $name, 3, + # $cmd can be "del" or "set" + # $name is device name + # aName and aVal are Attribute name and value + my $hash = $defs{$name}; + if ( $cmd eq "set" ) { + if ( $aName eq "trigger_length" ) { + if ( $aVal ne int($aVal) ) { + Log3 $name, 3, "S7_DWrite: Invalid $aName in attr $name $aName ($aVal is not a number): $@"; - return "Invalid $aName : $aVal is not a number"; + return "Invalid $aName : $aVal is not a number"; + } + + } + elsif ( $aName eq "IODev" ) { + Log3 $name, 4, "S7_DWrite: IODev for $name is $aVal"; + $hash->{IODev}{dirty} = 1; } } - elsif ( $aName eq "IODev" ) { - Log3 $name, 4, "S7_DWrite: IODev for $name is $aVal"; - $hash->{IODev}{dirty} = 1; - } - + return undef; } - return undef; -} -1; + 1; =pod +=item summary logical device for a digital writing to a S7/S5 +=item summary_DE logisches Device für einen binären Lese/Schreib Datenpunkt zu einer S5 / S7 =begin html - +

    S7_DWrite

      - This module is a logical module of the physical module S7.
      - This module is used to set/unset a Bit in ad DB of the PLC.
      - Note: you have to configure a PLC writing at the physical modul (S7) first.
      -
      - Define - -
        -
      • define <name> S7_DWrite {db} <DB> <address> - -
          -
        • db … defines where to read. Note currently only writing in to DB are supported.
          • -
        • DB … Number of the DB
          • -
        • address … address you want to write. bit number to read. Example: 10.6
          • -
        - Note: the required memory area need to be with in the configured PLC reading of the physical module. Set - -
          -
        • set <name> S7_AWrite {ON|OFF|TRIGGER};
          • -
          -   -
        •  
          • -
        •  
          • -
        - Note: TRIGGER sets the bit for 1s to ON than it will set to OFF.
        • -
      - -

      Attr
      - The following parameters are used to scale every reading

      - -
        -
      • -
          -
        • trigger_length ... sets the on-time of a trigger
          • -
        -
        • -
      +
        This module is a logical module of the physical module S7.
      +
    +
      +
        This module is used to set/unset a Bit in ad DB of the PLC.
      +
    +
      +
        Note: you have to configure a PLC writing at the physical modul (S7) first.
      +
    +




    Definedefine <name> S7_DWrite {db} <DB> <address>

    +
      +
        +
          +
            +
          • db … defines where to read. Note currently only writing in to DB are supported.
            • +
          • DB … Number of the DB
            • +
          • address … address you want to write. bit number to read. Example: 10.6
            • +
          +Note: the required memory area need to be with in the configured PLC reading of the physical module.
        +
      +
    +

    Setset <name> S7_AWrite {ON|OFF|TRIGGER};

    +
      +
        Note: TRIGGER sets the bit for 1s to ON than it will set to OFF.
      +
    +

    Attr
    The following parameters are used to scale every reading

    +
      +
    • trigger_length ... sets the on-time of a trigger
    - =end html =begin html_DE - +

    S7_DWrite

      - This module is a logical module of the physical module S7.
      - This module is used to set/unset a Bit in ad DB of the PLC.
      - Note: you have to configure a PLC writing at the physical modul (S7) first.
      -
      -
      - Define - -
        -
      • define <name> S7_DWrite {db} <DB> <position> - -
          -
        • db … defines where to read. Note currently only writing in to DB are supported.
          • -
        • DB … Number of the DB
          • -
        • address … address you want to write. bit number to read. Example: 10.6
          • -
        - Note: the required memory area need to be with in the configured PLC reading of the physical module.
        • -
        -
        -
        -   -
      •  
        • -
      - Set - -
        -
      • set <name> S7_AWrite {ON|OFF|TRIGGER};
        - Note: TRIGGER sets the bit for 1s to ON than it will set to OFF.
        • -
      - -

      Attr
      - The following parameters are used to scale every reading

      - -

       

      - -
        -
      • trigger_length ... sets the on-time of a trigger
        • -
      +
        This module is a logical module of the physical module S7.
      +
    +
      +
        This module is used to set/unset a Bit in ad DB of the PLC.
      +
    +
      +
        Note: you have to configure a PLC writing at the physical modul (S7) first.
      +
    +




    Definedefine <name> S7_DWrite {db} <DB> <position>

    +
      +
        +
          +
            +
          • db … defines where to read. Note currently only writing in to DB are supported.
            • +
          • DB … Number of the DB
            • +
          • address … address you want to write. bit number to read. Example: 10.6
            • +
          +Note: the required memory area need to be with in the configured PLC reading of the physical module.
        +
      +
    +


    Setset <name> S7_AWrite {ON|OFF|TRIGGER};

    +
      +
        Note: TRIGGER sets the bit for 1s to ON than it will set to OFF.
      +
    +

    Attr
    The following parameters are used to scale every reading

    +
      +
    • trigger_length ... sets the on-time of a trigger
    - =end html_DE =cut diff --git a/fhem/FHEM/44_S7_S5Client.pm b/fhem/FHEM/44_S7_S5Client.pm new file mode 100644 index 000000000..c06eab2d5 --- /dev/null +++ b/fhem/FHEM/44_S7_S5Client.pm @@ -0,0 +1,840 @@ +# $Id$ +############################################## + +use strict; +use warnings; +require Exporter; +use Config; +use AutoLoader; + +require "44_S7_Client.pm"; + +#if ( OS_Linux() ) { +use Device::SerialPort; + +#} +#else { +# use Win32::SerialPort; +#} + +package S5Client; + +#use S7ClientBase; +our @ISA = qw(S7ClientBase); # inherits from Person + +#---------------------- constants for communication + +use constant DLE => 0x10; +use constant ETX => 0x03; +use constant STX => 0x02; +use constant SYN => 0x16; +use constant NAK => 0x15; +use constant EOT => 0x04; # for S5 +use constant ACK => 0x06; # for S5 + +use constant daveS5BlockType_DB => 0x01; +use constant maxSysinfoLen => 87; +use constant daveMaxRawLen => 2048; + +use constant MaxPduSize => + 240; + + +sub new { + my $class = shift; + + my $self = $class->SUPER::new(); + + $self->{S5PAEAddress} = 0; + $self->{S5PAAAddress} = 0; + $self->{S5flagsAddress} = 0; + $self->{S5timerAddress} = 0; + $self->{S5counterAddress} = 0; + + $self->{__davet1006} = [ &DLE, &ACK ]; + $self->{__daveT161003} = [ 0x16, &DLE, &ETX ]; + $self->{__davet121003} = [ 0x12, &DLE, &ETX ]; + + $self->{PDULength} = &MaxPduSize; + + + #my @__davet1006 = ( &DLE, &ACK ); + #my @__daveT161003 = ( 0x16, &DLE, &ETX ); + #my @{$self->{__davet121003}} = ( 0x12, &DLE, &ETX ); + + return bless $self, $class; +} + +# ----------- compare arrays + +sub compare { + my ( $self, $a_ref, $b_ref ) = @_; + my @a = @{$a_ref}; # dereferencing and copying each array + my @b = @{$b_ref}; + + if ( @a != @b ) { + + return 0; + } + else { + foreach ( my $i = 0 ; $i < @a ; $i++ ) { + + # Ideally, check for undef/value comparison here as well + if ( $a[$i] != $b[$i] ) + { # use "ne" if elements are strings, not numbers + # Or you can use generic sub comparing 2 values + return 0; + } + } + return 1; + } +} + +# +# ----------- This writes a single chracter to the serial interface +# + +sub S5SendSingle($$) { + my ( $self, $c ) = @_; + my $buffer = pack( 'C*', $c ); + + my $tbuffer = join( ", ", unpack( "H2 " x length($buffer), $buffer ) ); + main::Log3( undef, 5, "S5Client S5SendSingle <-- " . $tbuffer ); + + $self->{serial}->write($buffer); +} + +#---------------------------------------------------reqest transaction with PLC + +sub S5ReqTrans($$) { + my ( $self, $trN ) = @_; + my $buffer; + my $count; + my $tbuffer; + + $self->S5SendSingle(&STX); #start trasmission + #expected S5 awnswer DLE,ACK + + ( $count, $buffer ) = $self->{serial}->read(2); + my @cbuffer = unpack( "C" x $count, $buffer ); + + if ( $main::attr{global}{verbose} >= 5 ) { + $tbuffer = join( ", ", unpack( "H2 " x $count, $buffer ) ); + main::Log3( undef, 5, "S5Client S5ReqTrans $tbuffer -->" ); + } + + if ( $self->compare( \@cbuffer, \@{ $self->{__davet1006} } ) == 0 ) { + main::Log3( undef, 3, "S5Client S5ReqTrans: no DLE,ACK before send" ); + return -1; + } + $self->S5SendSingle($trN); + ( $count, $buffer ) = $self->{serial}->read(1); + + if ( $main::attr{global}{verbose} >= 5 ) { + $tbuffer = join( ", ", unpack( "H2 " x $count, $buffer ) ); + main::Log3( undef, 5, "S5Client S5ReqTrans $tbuffer -->" ); + } + + if ( $count != 1 ) { + + #error awnser is too short + return -1; + } + @cbuffer = unpack( "C" x $count, $buffer ); + + if ( $cbuffer[0] ne &STX ) { + main::Log3( undef, 3, "S5Client S5ReqTrans: no STX before send" ); + return -2; + } + + $self->S5SendDLEACK(); + ( $count, $buffer ) = $self->{serial}->read(3); + + if ( $main::attr{global}{verbose} >= 5 ) { + $tbuffer = join( ", ", unpack( "H2 " x $count, $buffer ) ); + main::Log3( undef, 5, "S5Client S5ReqTrans $tbuffer -->" ); + } + + @cbuffer = unpack( "C" x $count, $buffer ); + if ( $self->compare( \@cbuffer, \@{ $self->{__daveT161003} } ) == 0 ) { + main::Log3( undef, 3, "S5Client S5ReqTrans: no accept0 from plc" ); + return -3; + } + + $self->S5SendDLEACK(); + return 0; +} + +sub S5SendDLEACK($) { + my ($self) = @_; + + my $buffer = pack( 'C2', @{ $self->{__davet1006} } ); + + if ( $main::attr{global}{verbose} >= 5 ) { + my $tbuffer = join( ", ", unpack( "H2 " x 2, $buffer ) ); + main::Log3( undef, 5, "S5Client S5SendDLEACK <-- $tbuffer" ); + } + + return $self->{serial}->write($buffer); +} + +#---------------------------------------------- S5 Exchange data + +sub S5ExchangeAS511($$$$$) { + my ( $self, $b, $len, $maxlen, $trN ) = @_; + + my ( $res, $i, $b1, $count ); + my @cbuffer; + my $msgIn = ""; + my $tbuffer; + + $res = $self->S5ReqTrans($trN); + if ( $res < 0 ) { + + main::Log3( undef, 3, + "S5Client S5ExchangeAS511: Error in Exchange.ReqTrans request" ); + return ( $res - 10, "" ); + } + + if ( $trN == 8 ) { #Block write functions have advanced syntax + #LOG1("trN 8\n"); + $self->S5SendWithDLEDup( $b, 4 ); + + #LOG1("trN 8 done\n"); + } + else { + + #LOG3("trN %d len %d\n",trN,len); + $self->S5SendWithDLEDup( $b, $len ); + + #LOG2("trN %d done\n",trN); + } + + ( $count, $b1 ) = $self->{serial}->read(2); + +# if ( $main::attr{global}{verbose} >= 5 ) { + $tbuffer = join( ", ", unpack( "H2 " x $count, $b1 ) ); + main::Log3( undef, 5, "S5Client S5ExchangeAS511 $tbuffer -->" ); +# } + + @cbuffer = unpack( "C" x $count, $b1 ); + if ( $self->compare( \@cbuffer, \@{ $self->{__davet1006} } ) == 0 ) { + main::Log3( undef, 3, + "S5Client S5ExchangeAS511: no DLE,ACK in Exchange request" ); + return ( -1, "" ); + } + + if ( ( $trN != 3 ) && ( $trN != 7 ) && ( $trN != 9 ) ) { + + #write bytes, compress & delblk + if ( !$self->S5ReadSingle() eq &STX ) { + main::Log3( undef, 3, + "S5Client S5ExchangeAS511: no STX in Exchange request" ); + return ( -2, "" ); + } + + $self->S5SendDLEACK(); + $res = 0; + @cbuffer = (); + my $buffer = ""; + do { + + ( $i, $b1 ) = $self->{serial}->read(1); + + $res += $i; + push( @cbuffer, unpack( "C" x $i, $b1 ) ) if ( $i > 0 ); + + } while ( + ( $i > 0 ) + && ( ( $cbuffer[ $res - 2 ] != &DLE ) + || ( $cbuffer[ $res - 1 ] != &ETX ) ) + ); + + if ( $main::attr{global}{verbose} >= 5 ) { + $tbuffer = + join( ", ", unpack( "H2 " x @cbuffer, pack( "C*", @cbuffer ) ) ); + main::Log3( undef, 5, "S5Client S5ExchangeAS511 $tbuffer -->" ); + } + + #LOG3( "%s *** got %d bytes.\n", dc->iface->name, res ); + + if ( $res < 0 ) { + main::Log3( undef, 3, + "S5Client S5ExchangeAS511: Error in Exchange.ReadChars request" + ); + + return ( $res - 20, "" ); + } + + if ( ( $cbuffer[ $res - 2 ] != &DLE ) + || ( $cbuffer[ $res - 1 ] != &ETX ) ) + { + main::Log3( undef, 3, + "S5Client S5ExchangeAS511: No DLE,ETX in Exchange data." ); + return ( -4, "" ); + } + + ( $res, $msgIn ) = $self->S5DLEDeDup( \@cbuffer ); + if ( $res < 0 ) { + main::Log3( undef, 3, + "S5Client S5ExchangeAS511: Error in Exchange rawdata." ); + return ( -3, "" ); + } + + $self->S5SendDLEACK(); + } + + if ( $trN == 8 ) { # Write requests have more differences from others + @cbuffer = unpack( "C" x length($msgIn), $msgIn ); + + if ( $cbuffer[0] != 9 ) { #todo fix + main::Log3( undef, 3, + "S5Client S5ExchangeAS511 No 0x09 in special Exchange request." + ); + return ( -5, "" ); + } + $self->S5SendSingle(&STX); + + ( $count, $b1 ) = $self->{serial}->read(2); + + if ( $main::attr{global}{verbose} >= 5 ) { + $tbuffer = $tbuffer = join( ", ", unpack( "H2 " x $count, $b1 ) ); + main::Log3( undef, 5, "S5Client S5ExchangeAS511 $tbuffer -->" ); + } + + @cbuffer = unpack( "C" x $count, $b1 ); + if ( $self->compare( \@cbuffer, \@{ $self->{__davet1006} } ) == 0 ) { + main::Log3( undef, 3, +"S5Client S5ExchangeAS511 no DLE,ACK in special Exchange request" + ); + return ( -6, "" ); + } + + my $b2 = substr( $b, 4 ); + $self->S5SendWithDLEDup( $b2, $len ); # todo need testing !!! + #$self->S5SendWithDLEDup(dc->iface,b+4,len); # + + ( $count, $b1 ) = $self->{serial}->read(2); + + if ( $main::attr{global}{verbose} >= 5 ) { + $tbuffer = join( ", ", unpack( "H2 " x $count, $b1 ) ); + main::Log3( undef, 5, "S5Client S5ExchangeAS511 $tbuffer -->" ); + } + + @cbuffer = unpack( "C" x $count, $b1 ); + if ( $self->compare( \@cbuffer, \@{ $self->{__davet1006} } ) == 0 ) { + main::Log3( undef, 3, +"S5Client S5ExchangeAS511 no DLE,ACK after transfer in Exchange." + ); + return ( -7, "" ); + } + } + + if ( $trN == 7 ) { + } + $res = $self->S5EndTrans(); + if ( $res < 0 ) { + main::Log3( undef, 3, + "S5Client S5ExchangeAS511 Error in Exchange.EndTrans request." ); + return ( $res - 30, "" ); + } + return ( 0, $msgIn ); +} + +# +# Sends a sequence of characters after doubling DLEs and adding DLE,EOT. +# +sub S5SendWithDLEDup($$$) { + my ( $self, $b, $size ) = @_; + + # uc target[&daveMaxRawLen]; + my @target; + my $res; + my $i; #preload + + my @cbuffer = unpack( "C" x $size, $b ); + + #LOG1("SendWithDLEDup: \n"); + #_daveDump("I send",b,size); + + for ( $i = 0 ; $i < $size ; $i++ ) { + push( @target, $cbuffer[$i] ); + + if ( $cbuffer[$i] == &DLE ) { + push( @target, &DLE ); + } + } + + push( @target, &DLE ); + push( @target, &EOT ); + + #LOGx_daveDump("I send", target, targetSize); + + my $buffer = pack( 'C*', @target ); + + $res = $self->{serial}->write($buffer); + + if ( $main::attr{global}{verbose} >= 5 ) { + my $tbuffer = join( ", ", unpack( "H2 " x length($buffer), $buffer ) ); + main::Log3( undef, 5, "S5Client S5SendWithDLEDup <-- $tbuffer" ); + } + + #if(daveDebug & daveDebugExchange) + #LOG2("send: res:%d\n",res); + return 0; +} + +# +# Remove the DLE doubling: +# + +sub S5DLEDeDup($$) { + + my ( $self, $b ) = @_; + my @rawBuf = @{$b}; + + my @msg = (); + + my $j = 0; + my $k; + for ( $k = 0 ; $k < @rawBuf - 2 ; $k++ ) { + push( @msg, $rawBuf[$k] ); + + if ( DLE == $rawBuf[$k] ) { + if ( DLE != $rawBuf[ $k + 1 ] ) { + return ( -1, "" ); #Bad doubling found + } + $k++; + } + } + + push( @msg, $rawBuf[$k] ); + $k++; + push( @msg, $rawBuf[$k] ); + + $b = pack( 'C*', @msg ); + + return ( 0, $b ); +} + +# +# Executes part of the dialog required to terminate transaction: +# + +sub S5EndTrans($) { + my ($self) = @_; + + #LOG2("%s daveEndTrans\n", dc->iface->name); + if ( $self->S5ReadSingle() ne &STX ) { + + #LOG2("%s daveEndTrans *** no STX at eot sequense.\n", dc->iface->name); + #return -1; + } + $self->S5SendDLEACK(); + + my ( $res, $b1 ) = $self->{serial}->read(3); + + if ( $main::attr{global}{verbose} >= 5 ) { + my $tbuffer = join( ", ", unpack( "H2 " x $res, $b1 ) ); + main::Log3( undef, 5, "S5Client S5EndTrans $tbuffer -->" ); + } + + #_daveDump("3got",b1, res); + + my @cbuffer = unpack( "C" x $res, $b1 ); + if ( $self->compare( \@cbuffer, \@{ $self->{__davet121003} } ) == 0 ) { + main::Log3( undef, 3, + "S5Client S5EndTransno accept of eot/ETX from plc." ); + return -2; + } + + $self->S5SendDLEACK(); + return 0; + +} + +# +# This reads a single chracter from the serial interface: + +sub S5ReadSingle ($) { + my ($self) = @_; + my ( $res, $i ); + + ( $i, $res ) = $self->{serial}->read(1); + if ( $main::attr{global}{verbose} >= 5 ) { + my $tbuffer = join( ", ", unpack( "H2 " x $i, $res ) ); + main::Log3( undef, 5, "S5Client S5ReadSingle $tbuffer -->" ); + } + + #if ((daveDebug & daveDebugSpecialChars)!=0) + # LOG3("readSingle %d chars. 1st %02X\n",i,res); + if ( $i == 1 ) { + return $res; + } + return 0; + +} + +#-------------------------------------------------------------------------------- +# Connect to S5 CPU +# + +sub S5ConnectPLCAS511($$) { + my ( $self, $portName ) = @_; + my $b1 = ""; + my $ttyPort; + + #if ( OS_Linux() ) { + $self->{serial} = new Device::SerialPort($portName); + + #} + #else { + # $ttyPort = new Win32::SerialPort( $portName ); + #} + + main::Log3( undef, 3, "Can't open serial port $portName" ) + unless ( $self->{serial} ); + die unless ( $self->{serial} ); + + $self->{serial}->baudrate(9600); + $self->{serial}->databits(8); + $self->{serial}->parity('even'); + $self->{serial}->stopbits(1); + + $self->{serial}->read_const_time(500); # 500 milliseconds = 0.5 seconds + $self->{serial}->read_char_time(10); # avg time between read char + + #$ttyPort->handshake('none'); + #$ttyPort->stty_icrnl(1); + #$ttyPort->stty_ocrnl(1); + #$ttyPort->stty_onlcr(1); + #$ttyPort->stty_opost(1) + + $self->{serial}->write_settings(); + + $b1 = pack( "C*", 0, 0 ); + my ( $res, $msgIn ) = + $self->S5ExchangeAS511( $b1, 2, &maxSysinfoLen, 0x18 ); + + if ( $res < 0 ) { + main::Log3( undef, 3, + "S5Client S5ConnectPLCAS511 ImageAddr.Exchange sequence" ); + return $res - 10; + } + if ( length($msgIn) < 47 ) { + main::Log3( undef, 3, + "S5Client S5ConnectPLCAS511 Too few chars in ImageAddr data" ); + return -2; + } + + #_daveDump("connect:",dc->msgIn, 47); + + my @cbuffer = unpack( "C" x length($msgIn), $msgIn ); + $self->{S5PAEAddress} = + $self->WordAt( \@cbuffer, 5 ); # start of inputs; + $self->{S5PAAAddress} = $self->WordAt( \@cbuffer, 7 ); # start of outputs + $self->{S5flagsAddress} = + $self->WordAt( \@cbuffer, 9 ); # start of flag (marker) memory; + $self->{S5timerAddress} = + $self->WordAt( \@cbuffer, 11 ); #start of timer memory; + $self->{S5counterAddress} = + $self->WordAt( \@cbuffer, 13 ); #start of counter memory + + main::Log3( undef, 3, + "S5Client ->S5ConnectPLCAS511 start of inputs in memory " + . $self->{S5PAEAddress} ); + main::Log3( undef, 3, + "S5Client ->S5ConnectPLCAS511 start of outputs in memory " + . $self->{S5PAAAddress} ); + main::Log3( undef, 3, + "S5Client ->S5ConnectPLCAS511 start of flags in memory " + . $self->{S5flagsAddress} ); + main::Log3( undef, 3, + "S5Client ->S5ConnectPLCAS511 start of timers in memory " + . $self->{S5timerAddress} ); + main::Log3( undef, 3, + "S5Client ->S5ConnectPLCAS511 start of counters in memory " + . $self->{S5counterAddress} ); + + + + return 0; + +} + +# +# Reads bytes from area with offset , +# that can be readed with daveGetInteger etc. You can read bytes from +# PBs & FBs too, but use daveReadBlock for this: +# + +sub S5ReadS5Bytes($$$$$) { + my ( $self, $area, $BlockN, $offset, $count ) = @_; + my ( $res, $dataend, $datastart, $b1, $msgIn ); + + if ( $area == &S7ClientBase::S7AreaDB ) { #DB + ( $res, $datastart ) = $self->S5ReadS5BlockAddress( $area, $BlockN ); + if ( $res < 0 ) { + main::Log3( undef, 3, + "S5Client S5ReadS5Bytes Error in ReadS5Bytes.BlockAddr request" + ); + return ( $res - 50, "" ); + } + } + elsif ( $area == &S7ClientBase::S7AreaPE ) { #inputs + + $datastart = + $self->{S5PAEAddress}; #need to get this information from a property + + } + elsif ( $area == &S7ClientBase::S7AreaPA ) { #outputs + + $datastart = + $self->{S5PAAAddress}; #need to get this information from a property + + } + elsif ( $area == &S7ClientBase::S7AreaMK ) { #flags + + $datastart = + $self->{S5flagsAddress}; #need to get this information from a property + + } + elsif ( $area == &S7ClientBase::S7AreaTM ) { #timers + + $datastart = + $self->{S5timerAddress}; #need to get this information from a property + + } + elsif ( $area == &S7ClientBase::S7AreaCT ) { #counters + + $datastart = $self + ->{S5counterAddress}; #need to get this information from a property + } + else { + main::Log3( undef, 3, + "S5Client S5ReadS5Bytes Unknown area in ReadS5Bytes request" ); + return ( -1, "" ); + + } + + if ( $count > &daveMaxRawLen ) { + main::Log3( undef, 3, + "S5Client S5ReadS5Bytes: Requested data is out-of-range" ); + return ( -1, "" ); + } + $datastart += $offset; + $dataend = $datastart + $count - 1; + + $b1 = pack( "C*", + $datastart / 256, + $datastart % 256, + $dataend / 256, + $dataend % 256 ); + + ( $res, $msgIn ) = $self->S5ExchangeAS511( $b1, 4, 2 * $count + 7, 0x04 ); + + if ( $res < 0 ) { + main::Log3( undef, 3, + "S5Client S5ReadS5Bytes Error in ReadS5Bytes.Exchange sequence" ); + return ( $res - 10, "" ); + } + +#if (dc->AnswLeniface->name,dc->AnswLen); +#return (-5,""); +#} + + my @cbuffer = unpack( "C" x length($msgIn), $msgIn ); + + if ( ( $cbuffer[0] != 0 ) + || ( $cbuffer[1] != 0 ) + || ( $cbuffer[2] != 0 ) + || ( $cbuffer[3] != 0 ) + || ( $cbuffer[4] != 0 ) ) + { + main::Log3( undef, 3, + "S5Client S5ReadS5Bytes Wrong ReadS5Bytes data signature" ); + return ( -6, "" ); + } + + $msgIn = substr( $msgIn, 5, -2 ); + return ( 0, $msgIn ); + +} + +# +# Requests physical addresses and lengths of blocks in PLC memory and writes +# them to ai structure: +# + +sub S5ReadS5BlockAddress($$$) { + my ( $self, $area, $BlockN ) = @_; + my ( $res, $msgIn, $dbaddr, $dblen, $ai ); + + my $b1 = pack( "C*", &daveS5BlockType_DB, $BlockN ) + ; #note we only support DB, no PB,FB,SB + + ( $res, $msgIn ) = $self->S5ExchangeAS511( $b1, 2, 24, 0x1A ); + + if ( $res < 0 ) { + main::Log3( undef, 3, +"S5Client >S5ReadS5BlockAddress Error in BlockAddr.Exchange sequense" + ); + return ( $res - 10, 0, 0 ); + } + if ( length($msgIn) < 15 ) { + main::Log3( undef, 3, + "S5Client S5ReadS5BlockAddress Too few chars in BlockAddr data." ); + return ( -2, 0, 0 ); + } + + my @cbuffer = unpack( "C" x length($msgIn), $msgIn ); + + if ( ( $cbuffer[0] != 0 ) + || ( $cbuffer[3] != 0x70 ) + || ( $cbuffer[4] != 0x70 ) + || ( $cbuffer[5] != 0x40 + &daveS5BlockType_DB ) + || ( $cbuffer[6] != $BlockN ) ) + { + main::Log3( undef, 3, + "S5Client S5ReadS5BlockAddress Wrong BlockAddr data signature." ); + + return ( -3, 0, 0 ); + } + + $dbaddr = $cbuffer[1]; + $dbaddr = + $dbaddr * 256 + + $cbuffer[2]; #Let make shift operations to compiler's optimizer + + $dblen = $cbuffer[11]; + $dblen = + ( $dblen * 256 + $cbuffer[12] - 5 ) * + 2; #PLC returns dblen in words including + #5 word header (but returnes the + #start address after the header) so + #dblen is length of block body + return ( 0, $dbaddr, $dblen ); + +} + +# +# Writes bytes from area with offset from buf. +# You can't write data to the program blocks because you can't syncronize +# with PLC cycle. For this purposes use daveWriteBlock: +# + +sub S5WriteS5Bytes($$$$$$) { + my ( $self, $area, $BlockN, $offset, $count, $buf ) = @_; + my ( $res, $datastart, $dblen, $b1, $msgIn ); + + if ( $area == &S7ClientBase::S7AreaDB ) { #DB + ( $res, $datastart, $dblen ) = + $self->S5ReadS5BlockAddress( $area, $BlockN ); + if ( $res < 0 ) { + main::Log3( undef, 3, +"S5Client S5WriteS5Bytes Error in ReadS5Bytes.BlockAddr request." + ); + return $res - 50; + } + } + elsif ( $area == &S7ClientBase::S7AreaPE ) { #inputs + + $datastart = + $self->{S5PAEAddress}; #need to get this information from a property + + $dblen = 128; + + } + elsif ( $area == &S7ClientBase::S7AreaPA ) { #outputs + + $datastart = + $self->{S5PAAAddress}; #need to get this information from a property + + $dblen = 128; + + } + elsif ( $area == &S7ClientBase::S7AreaMK ) { #flags + + $datastart = + $self->{S5flagsAddress}; #need to get this information from a property + + #$dblen = 128; # S5-90U + $dblen = 256; # S5-95U + + } + elsif ( $area == &S7ClientBase::S7AreaTM ) { #timers + + $datastart = + $self->{S5timerAddress}; #need to get this information from a property + + #$dblen = 32 *2; # S5-90U + $dblen = 128 *2; # S5-95U + + } + elsif ( $area == &S7ClientBase::S7AreaCT ) { #counters + + $datastart = $self + ->{S5counterAddress}; #need to get this information from a property + + #$dblen = 32 *2; # S5-90U + $dblen = 128 * 2; # S5-95U + + } + else { + main::Log3( undef, 3, + "S5Client S5WriteS5Bytes Unknown area in WriteS5Bytes request." ); + return -1; + } + + + + + if ( ( $count > &daveMaxRawLen ) || ( $offset + $count > $dblen ) ) { + main::Log3( undef, 3, + "S5Client S5WriteS5Bytes Requested data is out-of-range." ); + return -1; + } + + #LOG2("area start is %04x, ",datastart); + $datastart += $offset; + + #LOG2("data start is %04x\n",datastart); + + $b1 = pack( "C*", $datastart / 256, $datastart % 256 ); + + $b1 = $b1 . $buf; + + ( $res, $msgIn ) = $self->S5ExchangeAS511( $b1, 2 + $count, 0, 0x03 ); + if ( $res < 0 ) { + main::Log3( undef, 3, + "S5Client S5WriteS5Bytes Error in WriteS5Bytes.Exchange sequense." + ); + return $res - 10; + } + return 0; +} +1; +=pod +=item summary low level interface to S5 +=item summary_DE low level interface to S5 + +=begin html + +

    +

    S7_S5Client

    +
      +
        low level interface to S5
      +
    +=end html +=begin html_DE + +

    +

    S7_S5Client

    +
      +
        low level interface to S5
      +
    + +=end html_DE + +=cut \ No newline at end of file diff --git a/fhem/FHEM/44_S7_S7Client.pm b/fhem/FHEM/44_S7_S7Client.pm new file mode 100644 index 000000000..f94e94a1a --- /dev/null +++ b/fhem/FHEM/44_S7_S7Client.pm @@ -0,0 +1,1337 @@ +# $Id$ +############################################## + +use strict; +use warnings; +require Exporter; +use Config; +use AutoLoader; + + +require "44_S7_Client.pm" ; + +#use Socket; +use IO::Socket::INET; +use IO::Select; + +#todo + +#fehler in settimino: +#function :WriteArea & ReadArea +#bit shift opteratin in wrong direction +# PDU.H[23]=NumElements<<8; --> PDU.H[23]=NumElements>>8; +# PDU.H[24]=NumElements; + + +our @ISA = qw(Exporter); + +our %EXPORT_TAGS = ( + 'all' => [ + qw( + errTCPConnectionFailed + errTCPConnectionReset + errTCPDataRecvTout + errTCPDataSend + errTCPDataRecv + errISOConnectionFailed + errISONegotiatingPDU + errISOInvalidPDU + errS7InvalidPDU + errS7SendingPDU + errS7DataRead + errS7DataWrite + errS7Function + errBufferTooSmall + Code7Ok + Code7AddressOutOfRange + Code7InvalidTransportSize + Code7WriteDataSizeMismatch + Code7ResItemNotAvailable + Code7ResItemNotAvailable1 + Code7InvalidValue + Code7NeedPassword + Code7InvalidPassword + Code7NoPasswordToClear + Code7NoPasswordToSet + Code7FunNotAvailable + Code7DataOverPDU + S7_PG + S7_OP + S7_Basic + ISOSize + isotcp + MinPduSize + MaxPduSize + CC + S7Shift + S7WLBit + S7WLByte + S7WLWord + S7WLDWord + S7WLReal + S7WLCounter + S7WLTimer + S7CpuStatusUnknown + S7CpuStatusRun + S7CpuStatusStop + RxOffset + Size_RD + Size_WR + Size_DT + ) + ] +); + +our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); + +our @EXPORT = qw( + errTCPConnectionFailed + errTCPConnectionReset + errTCPDataRecvTout + errTCPDataSend + errTCPDataRecv + errISOConnectionFailed + errISONegotiatingPDU + errISOInvalidPDU + errS7InvalidPDU + errS7SendingPDU + errS7DataRead + errS7DataWrite + errS7Function + errBufferTooSmall + Code7Ok + Code7AddressOutOfRange + Code7InvalidTransportSize + Code7WriteDataSizeMismatch + Code7ResItemNotAvailable + Code7ResItemNotAvailable1 + Code7InvalidValue + Code7NeedPassword + Code7InvalidPassword + Code7NoPasswordToClear + Code7NoPasswordToSet + Code7FunNotAvailable + Code7DataOverPDU + S7_PG + S7_OP + S7_Basic + ISOSize + isotcp + MinPduSize + MaxPduSize + CC + S7Shift + S7WLBit + S7WLByte + S7WLWord + S7WLDWord + S7WLReal + S7WLCounter + S7WLTimer + S7CpuStatusUnknown + S7CpuStatusRun + S7CpuStatusStop + RxOffset + Size_RD + Size_WR + Size_DT +); + +package S7Client; + +use strict; + +#use S7ClientBase; + + +our @ISA = qw(S7ClientBase); # inherits from Person + +# Error Codes +# from 0x0001 up to 0x00FF are severe errors, the Client should be disconnected +# from 0x0100 are S7 Errors such as DB not found or address beyond the limit etc.. +# For Arduino Due the error code is a 32 bit integer but this doesn't change the constants use. + +use constant errTCPConnectionFailed => 0x0001; +use constant errTCPConnectionReset => 0x0002; +use constant errTCPDataRecvTout => 0x0003; +use constant errTCPDataSend => 0x0004; +use constant errTCPDataRecv => 0x0005; +use constant errISOConnectionFailed => 0x0006; +use constant errISONegotiatingPDU => 0x0007; +use constant errISOInvalidPDU => 0x0008; + +use constant errS7InvalidPDU => 0x0100; +use constant errS7SendingPDU => 0x0200; +use constant errS7DataRead => 0x0300; +use constant errS7DataWrite => 0x0400; +use constant errS7Function => 0x0500; + +use constant errBufferTooSmall => 0x0600; + +#CPU Errors + +# S7 outcoming Error code +use constant Code7Ok => 0x0000; +use constant Code7AddressOutOfRange => 0x0005; +use constant Code7InvalidTransportSize => 0x0006; +use constant Code7WriteDataSizeMismatch => 0x0007; +use constant Code7ResItemNotAvailable => 0x000A; +use constant Code7ResItemNotAvailable1 => 0xD209; +use constant Code7InvalidValue => 0xDC01; +use constant Code7NeedPassword => 0xD241; +use constant Code7InvalidPassword => 0xD602; +use constant Code7NoPasswordToClear => 0xD604; +use constant Code7NoPasswordToSet => 0xD605; +use constant Code7FunNotAvailable => 0x8104; +use constant Code7DataOverPDU => 0x8500; + +# Connection Type +use constant S7_PG => 0x01; +use constant S7_OP => 0x02; +use constant S7_Basic => 0x03; + +# ISO and PDU related constants +use constant ISOSize => 7; # Size of TPKT + COTP Header +use constant isotcp => 102; # ISOTCP Port +use constant MinPduSize => 16; # Minimum S7 valid telegram size +use constant MaxPduSize => + 247; # Maximum S7 valid telegram size (we negotiate 240 bytes + ISOSize) +use constant CC => 0xD0; # Connection confirm +use constant S7Shift => + 17; # We receive data 17 bytes above to align with PDU.DATA[] + +# WordLength +use constant S7WLBit => 0x01; +use constant S7WLByte => 0x02; +use constant S7WLChar => 0x03; +use constant S7WLWord => 0x04; +use constant S7WLInt => 0x05; +use constant S7WLDWord => 0x06; +use constant S7WLDInt => 0x07; +use constant S7WLReal => 0x08; +use constant S7WLCounter => 0x1C; +use constant S7WLTimer => 0x1D; + +# Result transport size +use constant TS_ResBit => 0x03; +use constant TS_ResByte => 0x04; +use constant TS_ResInt => 0x05; +use constant TS_ResReal => 0x07; +use constant TS_ResOctet => 0x09; + +use constant S7CpuStatusUnknown => 0x00; +use constant S7CpuStatusRun => 0x08; +use constant S7CpuStatusStop => 0x04; + +use constant RxOffset => 18; +use constant Size_DT => 25; +use constant Size_RD => 31; +use constant Size_WR => 35; + + + + +sub new { + my $class = shift; + + my $self = $class->SUPER::new(); + + $self->{LocalTSAP_HI} = 0x01; + $self->{LocalTSAP_LO} = 0x00; + $self->{RemoteTSAP_HI} = 0x01; + $self->{RemoteTSAP_LO} = 0x02; + $self->{ConnType} = &S7_PG; + $self->{LastError} = 0; + $self->{LastPDUType} = 0; + $self->{Peer} = ""; + $self->{ISO_CR} = ""; + $self->{S7_PN} = ""; + $self->{S7_RW} = ""; + $self->{PDU} = {}; + $self->{cntword} = 0; + + #ISO Connection Request telegram (contains also ISO Header and COTP Header) + $self->{ISO_CR} = pack( + "C22", + + # TPKT (RFC1006 Header) + 0x03, # RFC 1006 ID (3) + 0x00, # Reserved, always 0 + 0x00 + , # High part of packet length (entire frame, payload and TPDU included) + 0x16 + , # Low part of packet length (entire frame, payload and TPDU included) + # COTP (ISO 8073 Header) + 0x11, # PDU Size Length + 0xE0, # CR - Connection Request ID + 0x00, # Dst Reference HI + 0x00, # Dst Reference LO + 0x00, # Src Reference HI + 0x01, # Src Reference LO + 0x00, # Class + Options Flags + 0xC0, # PDU Max Length ID + 0x01, # PDU Max Length HI + + 0x0A, # PDU Max Length LO # snap7 value Bytes 1024 + + # 0x09, # PDU Max Length LO # libnodave value Bytes 512 + + 0xC1, # Src TSAP Identifier + 0x02, # Src TSAP Length (2 bytes) + 0x01, # Src TSAP HI (will be overwritten by ISOConnect()) + 0x00, # Src TSAP LO (will be overwritten by ISOConnect()) + 0xC2, # Dst TSAP Identifier + 0x02, # Dst TSAP Length (2 bytes) + 0x01, # Dst TSAP HI (will be overwritten by ISOConnect()) + 0x02 # Dst TSAP LO (will be overwritten by ISOConnect()) + ); + + # S7 PDU Negotiation Telegram (contains also ISO Header and COTP Header) + $self->{S7_PN} = pack( + "C25", + 0x03, 0x00, 0x00, 0x19, 0x02, 0xf0, + 0x80, # TPKT + COTP (see above for info) + 0x32, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x08, 0x00, #snap7 trace + 0x00, 0xf0, 0x00, 0x00, 0x01, 0x00, 0x01, + + # 0x00, 0xf0 # PDU Length Requested = HI-LO 240 bytes + # 0x01, 0xe0 # PDU Length Requested = HI-LO 480 bytes + 0x03, 0xc0 # PDU Length Requested = HI-LO 960 bytes + ); + + # S7 Read/Write Request Header (contains also ISO Header and COTP Header) + $self->{S7_RW} = pack( + "C35", # 31-35 bytes + 0x03, 0x00, + 0x00, 0x1f, # Telegram Length (Data Size + 31 or 35) + 0x02, 0xf0, 0x80, # COTP (see above for info) + 0x32, # S7 Protocol ID + 0x01, # Job Type + 0x00, 0x00, # Redundancy identification (AB_EX) + 0x05, 0x00, # PDU Reference #snap7 (increment by every read/write) + 0x00, 0x0e, # Parameters Length + 0x00, 0x00, # Data Length = Size(bytes) + 4 + 0x04, # Function 4 Read Var, 5 Write Var + #reqest param head + 0x01, # Items count + 0x12, # Var spec. + 0x0a, # Length of remaining bytes + 0x10, # Syntax ID + &S7WLByte, # Transport Size + 0x00, 0x00, # Num Elements + 0x00, 0x00, # DB Number (if any, else 0) + 0x84, # Area Type + 0x00, 0x00, 0x00, # Area Offset + # WR area + 0x00, # Reserved + 0x04, # Transport size + 0x00, 0x00, # Data Length * 8 (if not timer or counter) + ); + + $self->{PDU}->{H} = pack( "C35", + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 ); + $self->{PDU}->{DATA} = ""; + + return bless $self, $class; +} + + +#----------------------------------------------------------------------------- +sub GetNextWord { + my $self = shift; + $self->{cntword} = 0 if ( $self->{cntword} == 0xFFFF ); + return $self->{cntword}++; +} + +#----------------------------------------------------------------------------- +sub SetLastError { + my ( $self, $Error ) = @_; + $self->{LastError} = $Error; + return $Error; +} + +#----------------------------------------------------------------------------- + +sub WaitForData { + my ( $self, $Size, $Timeout ) = @_; + my $BytesReady; + + $Timeout = $Timeout / 1000; + + # $Timeout = 1 if ($Timeout < 1); #deactivated in V2.9 + my @ready = $self->{TCPClientSel}->can_read($Timeout); + + if ( scalar(@ready) ) { + return $self->SetLastError(0); + } + + # Here we are in timeout zone, if there's something into the buffer, it must be discarded. + $self->{TCPClient}->flush(); + if ( !$self->{TCPClient}->connected() ) { + return $self->SetLastError(&errTCPConnectionReset); + } + + return $self->SetLastError(&errTCPDataRecvTout); +} + +#----------------------------------------------------------------------------- +sub IsoPduSize { + my ($self) = @_; + + my @buffer = unpack( "C" x 4, $self->{PDU}->{H} ); + my $Size = $buffer[2]; + return ( $Size << 8 ) + $buffer[3]; + +} + +#----------------------------------------------------------------------------- +sub RecvPacket { + my ( $self, $Size ) = @_; + my $buf; + + $self->WaitForData( $Size, $self->{RecvTimeout} ); + if ( $self->{LastError} != 0 ) { + + return $self->{LastError}; + } + + my $res = $self->{TCPClient}->recv( $buf, $Size ); + + if ( defined($buf) && length($buf) == $Size ) { + return ( $self->SetLastError(0), $buf ); + } + else { + + if ( defined($buf) ) { + + if ( $main::attr{global}{verbose} <= 3 ) { + my $b = join( ", ", unpack( "H2 " x length($buf), $buf ) ); + main::Log3 (undef, 3, "TCPClient RecvPacket error (IP= ". $self->{Peer} . "): " . $b); + } + } + else { + main::Log3 (undef, 3, "TCPClient RecvPacket error (IP= " . $self->{Peer} . ")."); + } + return $self->SetLastError( &errTCPConnectionReset, $buf ); + } +} + +#----------------------------------------------------------------------------- +sub SetConnectionParams { + + my ( $self, $Address, $LocalTSAP, $RemoteTSAP ) = @_; + + $self->{Peer} = $Address; + $self->{LocalTSAP_HI} = $LocalTSAP >> 8; + $self->{LocalTSAP_LO} = $LocalTSAP & 0x00FF; + $self->{RemoteTSAP_HI} = $RemoteTSAP >> 8; + $self->{RemoteTSAP_LO} = $RemoteTSAP & 0x00FF; +} + +#----------------------------------------------------------------------------- +sub SetConnectionType { + my ( $self, $ConnectionType ) = @_; + + $self->{ConnType} = $ConnectionType; +} + +#----------------------------------------------------------------------------- +sub ConnectTo { + my ( $self, $Address, $Rack, $Slot ) = @_; + + $self->SetConnectionParams( $Address, 0x0100, + ( $self->{ConnType} << 8 ) + ( $Rack * 0x20 ) + $Slot ); + + return $self->Connect(); +} + +#----------------------------------------------------------------------------- + +sub Connect { + my ($self) = @_; + $self->{LastError} = 0; + if ( !$self->{Connected} ) { + $self->TCPConnect(); + if ( $self->{LastError} == 0 ) # First stage : TCP Connection + { + $self->ISOConnect(); + if ( $self->{LastError} == + 0 ) # Second stage : ISOTCP (ISO 8073) Connection + { + $self->{LastError} = $self->NegotiatePduLength() + ; # Third stage : S7 PDU negotiation + } + } + } + + if ( $self->{LastError} == 0 ) { + $self->{Connected} = 1; + } + else { + $self->{Connected} = 0; + } + return $self->{LastError}; +} + +#----------------------------------------------------------------------------- +sub Disconnect { + my ($self) = @_; + if ( $self->{Connected} ) { + + $self->{TCPClientSel} = undef; + + if ( defined( $self->{TCPClient} ) ) { + my $res = shutdown( $self->{TCPClient}, 1 ); + if ( defined($res) ) { + $self->{TCPClient}->flush() if ( $res == 0 ); + } + $self->{TCPClient}->close(); + + $self->{TCPClient} = undef; + } + $self->{Connected} = 0; + $self->{PDULength} = 0; + $self->{MaxReadLength} = 0; + $self->{LastError} = 0; + } +} + +#----------------------------------------------------------------------------- +sub TCPConnect { + my ($self) = @_; + + # # 1. create a socket handle (descriptor) + # my($sock); + # socket($sock, AF_INET, SOCK_STREAM, IPPROTO_TCP);#TCP_NODELAY, + # + # or die "ERROR in Socket Creation: $!"; + # + # # 2. connect to remote server + # my $remote = $self->{Peer}; + # + # my $iaddr = inet_aton($remote) or die "Unable to resolve hostname : $remote"; + # my $paddr = sockaddr_in(&isotcp, $iaddr); #socket address structure + # + # connect($sock , $paddr) or die "connect to $remote failed : $!"; + # $self->{TCPClient} = $sock; + # return $self->SetLastError(0); + # + # $self->{TCPClientSel} = new IO::Select($self->{TCPClient}); + + $self->{TCPClient} = new IO::Socket::INET( + PeerAddr => $self->{Peer}, + + # PeerHost => $self->{Peer}, + PeerPort => &isotcp, + Type => Socket::SOCK_STREAM, # probably needed on some systems + + Proto => 'tcp', + ) or die "ERROR in Socket Creation: $!"; + + $self->{TCPClient}->sockopt( &Socket::TCP_NODELAY, 1 ); + + $self->{TCPClient}->autoflush(1); + + $self->{TCPClientSel} = new IO::Select( $self->{TCPClient} ); + + return $self->SetLastError(0); + +} + +#----------------------------------------------------------------------------- + +sub RecvISOPacket { + + my ($self) = @_; + my $Size; + + my $Done = 0; + my $pdubuffer = ""; + my $res; + + $self->{LastError} = 0; + while ( ( $self->{LastError} == 0 ) && !$Done ) { + + # Get TPKT (4 bytes) + ( $res, $pdubuffer ) = $self->RecvPacket(4); + if ( $self->{LastError} == 0 ) { + + my $b = join( ", ", unpack( "H2 " x 4, $pdubuffer ) ); + + $self->{PDU}->{H} = $pdubuffer . substr( $self->{PDU}->{H}, 4 ); + $Size = $self->IsoPduSize(); + main::Log3(undef, 5, "TCPClient RecvISOPacket Expected Size = $Size"); + + # Check 0 bytes Data Packet (only TPKT+COTP - 7 bytes) + if ( $Size == 7 ) { + $pdubuffer = ""; + ( $res, $pdubuffer ) = $self->RecvPacket(3); + + $self->{PDU}->{H} = $pdubuffer . substr( $self->{PDU}->{H}, 3 ); + + } + else { + my $maxlen = $self->{PDULength} + &ISOSize; + if ( $maxlen <= &MinPduSize ) { + $maxlen = &MaxPduSize; + } + + # if (($Size > &MaxPduSize) || ($Size < &MinPduSize)) { + if ( ( $Size > $maxlen ) || ( $Size < &MinPduSize ) ) { + main::Log3 (undef, 3, "TCPClient RecvISOPacket PDU overflow (IP= " . $self->{Peer} . "): size = $Size , maxPDULength = " . $self->{PDULength}); + $self->{LastError} = &errISOInvalidPDU; + } + else { + $Done = 1; # a valid Length !=7 && >16 && <247 + } + } + } + } + if ( $self->{LastError} == 0 ) { + $pdubuffer = ""; + ( $res, $pdubuffer ) = $self->RecvPacket(3); + + $self->{PDU}->{H} = $pdubuffer + . substr( $self->{PDU}->{H}, 3 ); # Skip remaining 3 COTP bytes + + my @mypdu = unpack( "C2", $self->{PDU}->{H} ); + + $self->{LastPDUType} = $mypdu[1]; # Stores PDU Type, we need it + $Size -= &ISOSize; + + # We need to align with PDU.DATA + + $pdubuffer = ""; + ( $res, $pdubuffer ) = $self->RecvPacket($Size); + + if ( $main::attr{global}{verbose} >= 5 ) { + my $b = join( ", ", unpack( "H2 " x $Size, $pdubuffer ) ); + main::Log3 (undef, 5, "TCPClient RecvISOPacket (IP= " . $self->{Peer} . "): $b"); + } + + #we write the data starting at position 17 (shift) into the PDU.H + if ( $self->{LastError} == 0 ) { + + if ( $Size > &Size_WR - &S7Shift ) { + my $headerSize = &Size_WR - &S7Shift; + + $self->{PDU}->{H} = + substr( $self->{PDU}->{H}, 0, &S7Shift ) + . substr( $pdubuffer, 0, $headerSize ); + + $self->{PDU}->{DATA} = substr( $pdubuffer, $headerSize ); + + } + else { + + $self->{PDU}->{H} = + substr( $self->{PDU}->{H}, 0, &S7Shift ) + . $pdubuffer + . substr( $self->{PDU}->{H}, &Size_WR - &S7Shift - $Size ); + } + } + + } + if ( $self->{LastError} != 0 ) { + $self->{TCPClient}->flush(); + } + return ( $self->{LastError}, $Size ); +} + +#----------------------------------------------------------------------------- + +sub ISOConnect { + my ($self) = @_; + + my $Done = 0; + my $myLength = 0; + my $res; + + # Setup TSAPs + my @myISO_CR = unpack( "C22", $self->{ISO_CR} ); + $myISO_CR[16] = $self->{LocalTSAP_HI}; + $myISO_CR[17] = $self->{LocalTSAP_LO}; + $myISO_CR[20] = $self->{RemoteTSAP_HI}; + $myISO_CR[21] = $self->{RemoteTSAP_LO}; + $self->{ISO_CR} = pack( "C22", @myISO_CR ); + + my $b = join( ", ", unpack( "H2 " x 22, $self->{ISO_CR} ) ); + + if ( $self->{TCPClient}->send( $self->{ISO_CR} ) == 22 ) + + # if (send($self->{TCPClient}, $self->{ISO_CR}, &MSG_NOSIGNAL)==22) + { + ( $res, $myLength ) = $self->RecvISOPacket(); + + if ( ( $self->{LastError} == 0 ) + && ( $myLength == 15 ) + ) # 15 = 22 (sizeof CC telegram) - 7 (sizeof Header) + { + if ( $self->{LastPDUType} == &CC ) { #Connection confirm + return 0; + } + else { + return $self->SetLastError(&errISOInvalidPDU); + } + } + else { + return $self->{LastError}; + } + } + else { + return $self->SetLastError(&errISOConnectionFailed); + } +} + +#----------------------------------------------------------------------------- +sub NegotiatePduLength { + my ($self) = @_; + + my $myLength; + my $res; + + # Setup TSAPs + my @myS7_PN = unpack( "C25", $self->{S7_PN} ); + my $myPDUID = $self->GetNextWord(); + $myS7_PN[11] = $myPDUID % 256; + $myS7_PN[12] = ( $myPDUID >> 8 ) % 256; + $self->{S7_PN} = pack( "C25", @myS7_PN ); + + if ( $self->{TCPClient}->send( $self->{S7_PN} ) == 25 ) + + # if (send($self->{TCPClient}, $self->{S7_PN}, &MSG_NOSIGNAL)==25) + { + ( $res, $myLength ) = $self->RecvISOPacket(); + if ( $self->{LastError} == 0 ) { + + # check S7 Error + my @myPDUheader = unpack( "C35", $self->{PDU}->{H} ); + + if ( ( $myLength == 20 ) + && ( $myPDUheader[27] == 0 ) + && ( $myPDUheader[28] == 0 ) ) # 20 = size of Negotiate Answer + { + my @myPDUdata = unpack( "C2", $self->{PDU}->{DATA} ); + + $self->{PDULength} = $myPDUdata[0]; + $self->{PDULength} = + ( $self->{PDULength} << 8 ) + + $myPDUdata[1]; # Value negotiated + + $self->{MaxReadLength} = ( $self->{PDULength} - 18 ); + + if ( $self->{PDULength} > 0 ) { + return 0; + } + else { + return $self->SetLastError(&errISONegotiatingPDU); + } + } + else { + return $self->SetLastError(&errISONegotiatingPDU); + } + } + else { + return $self->{LastError}; + } + } + else { + return $self->SetLastError(&errISONegotiatingPDU); + } +} + +sub getPDULength() { + my ($self) = @_; + + if ( $self->{Connected} ) { + return $self->{PDULength}; + } + + return -1; +} + +#----------------------------------------------------------------------------- +sub ReadArea () { + + my ( $self, $Area, $DBNumber, $Start, $Amount, $WordLen ) = @_; + + my $ptrData = ""; + + my $Address; + my $NumElements; + my $MaxElements; + my $TotElements; + my $SizeRequested; + my $myLength; + my $res; + + my $WordSize = 1; + + $self->{LastError} = 0; + + # If we are addressing Timers or counters the element size is 2 + $WordSize = 2 if ( ( $Area == &S7ClientBase::S7AreaCT ) || ( $Area == &S7ClientBase::S7AreaTM ) ); + + $MaxElements = + ( $self->{PDULength} - 18 ) / $WordSize; # 18 = Reply telegram header + $TotElements = $Amount; + + while ( ( $TotElements > 0 ) && ( $self->{LastError} == 0 ) ) { + $NumElements = $TotElements; + $NumElements = $MaxElements if ( $NumElements > $MaxElements ); + + $SizeRequested = $NumElements * $WordSize; + + # Setup the telegram + my @myPDU = + unpack( "C" x &Size_RD, substr( $self->{S7_RW}, 0, &Size_RD ) ); + + #my $b = join( ", ", unpack("H2 " x &Size_RD,$self->{S7_RW})); + # print "ReadArea: S7_RW :".$b."\n"; + + #set PDU Ref + my $myPDUID = $self->GetNextWord(); + $myPDU[11] = $myPDUID % 256; + $myPDU[12] = ( $myPDUID >> 8 ) % 256; + + $myPDU[20] = 0x0a; # Length of remaining bytes + $myPDU[21] = 0x10; # syntag ID + + # Set DB Number + $myPDU[27] = $Area; + if ( $Area == &S7ClientBase::S7AreaDB ) { + $myPDU[25] = ( $DBNumber >> 8 ) % 256; + $myPDU[26] = $DBNumber % 256; + } + else { + $myPDU[25] = 0x00; + $myPDU[26] = 0x00; + } + + # Adjusts Start + if ( ( $WordLen == &S7WLBit ) + || ( $WordLen == &S7WLCounter ) + || ( $WordLen == &S7WLTimer ) ) + { + $Address = $Start; + } + else { + $Address = $Start << 3; + } + + #set word length + $myPDU[22] = $WordLen; + + # Num elements + $myPDU[23] = ( $NumElements >> 8 ) + % 256; # hier ist denke ich ein fehler in der settimino.cpp + + $myPDU[24] = ($NumElements) % 256; + + # Address into the PLC + $myPDU[30] = ($Address) % 256; + $Address = $Address >> 8; + $myPDU[29] = ($Address) % 256; + $Address = $Address >> 8; + $myPDU[28] = ($Address) % 256; + + $self->{PDU}->{H} = + pack( "C" x &Size_RD, @myPDU ) + . substr( $self->{PDU}->{H}, &Size_RD ); + + if ( $main::attr{global}{verbose} >= 5 ) { + $b = join( ", ", unpack( "H2 " x &Size_RD, $self->{PDU}->{H} ) ); + main::Log3 (undef, 5, "TCPClient ReadArea (IP= " . $self->{Peer} . "): $b"); + } + + $b = substr( $self->{PDU}->{H}, 0, &Size_RD ); + if ( $self->{TCPClient}->send($b) == &Size_RD ) + { #Achtung PDU.H ist größer als &Size_RD + +# if (send($self->{TCPClient}, $b, &MSG_NOSIGNAL)== &Size_RD) #Achtung PDU.H ist größer als &Size_RD + + ( $res, $myLength ) = $self->RecvISOPacket(); + if ( $self->{LastError} == 0 ) { + if ( $myLength >= 18 ) { + + @myPDU = unpack( "C" x &Size_WR, $self->{PDU}->{H} ); + + if ( ( $myLength - 18 == $SizeRequested ) ) { + + #response was OK + $ptrData = + substr( $self->{PDU}->{DATA}, 0, $SizeRequested ) + ; # Copies in the user's buffer + } + else { # PLC reports an error + if ( $myPDU[31] == 0xFF ) { + + my $b = join( + ", ", + unpack( + "H2 " x $myLength, + $self->{PDU}->{H} . $self->{PDU}->{DATA} + ) + ); + main::Log3 (undef, 3, "TCPClient ReadArea error (IP= " . $self->{Peer}. ") returned data not expected size: $b"); + } + else { + my $b = join( + ", ", + unpack( + "H2 " x ( + length( $self->{PDU}->{H} ) + + length( $self->{PDU}->{DATA} ) + ), + $self->{PDU}->{H} . $self->{PDU}->{DATA} + ) + ); + main::Log3 (undef, 3, + "TCPClient ReadArea error (IP= " + . $self->{Peer} + . ") returned data not OK: $b"); + } + $self->{LastError} = &errS7DataRead; + } + } + else { + $self->{LastError} = &errS7InvalidPDU; + } + } + } + else { + $self->{LastError} = &errTCPDataSend; + } + + $TotElements -= $NumElements; + $Start += $NumElements * $WordSize; + } + return ( $self->{LastError}, $ptrData ); +} + +#----------------------------------------------------------------------------- + +sub WriteArea { + my ( $self, $Area, $DBNumber, $Start, $Amount, $WordLen, $ptrData ) = @_; + + my $Address; + my $NumElements; + my $MaxElements; + my $TotElements; + my $DataSize; + my $IsoSize; + my $myLength; + + my $Offset = 0; + my $WordSize = 1; + my $res; + + $self->{LastError} = 0; + + # If we are addressing Timers or counters the element size is 2 + $WordSize = 2 if ( ( $Area == &S7ClientBase::S7AreaCT ) || ( $Area == &S7ClientBase::S7AreaTM ) ); + + $MaxElements = + ( $self->{PDULength} - 35 ) / $WordSize; # 35 = Write telegram header + $TotElements = $Amount; + + while ( ( $TotElements > 0 ) && ( $self->{LastError} == 0 ) ) { + $NumElements = $TotElements; + if ( $NumElements > $MaxElements ) { + $NumElements = $MaxElements; + } + + #If we use the internal buffer only, we cannot exced the PDU limit + $DataSize = + $NumElements * $WordSize; #<------ Fehler Datasize sollte in Byte sein + $IsoSize = &Size_WR + $DataSize; + + # Setup the telegram + my @myPDU = + unpack( "C" x &Size_WR, substr( $self->{S7_RW}, 0, &Size_WR ) ); + + # Whole telegram Size + # PDU Length + $myPDU[2] = ( $IsoSize >> 8 ) % 256; + $myPDU[3] = $IsoSize % 256; + + #set PDU Ref + + my $myPDUID = $self->GetNextWord(); + $myPDU[11] = $myPDUID % 256; + $myPDU[12] = ( $myPDUID >> 8 ) % 256; + + # Data Length + $myLength = $DataSize + 4; + $myPDU[15] = ( $myLength >> 8 ) % 256; + $myPDU[16] = $myLength % 256; + + # Function + $myPDU[17] = 0x05; + + $myPDU[20] = 0x0a; # Length of remaining bytes + $myPDU[21] = 0x10; # syntag ID + + # Set DB Number + $myPDU[27] = $Area; + if ( $Area == &S7ClientBase::S7AreaDB ) { + $myPDU[25] = ( $DBNumber >> 8 ) % 256; + $myPDU[26] = $DBNumber % 256; + } + + # Adjusts Start + if ( ( $WordLen == &S7WLBit ) + || ( $WordLen == &S7WLCounter ) + || ( $WordLen == &S7WLTimer ) ) + { + $Address = $Start; + } + else { + $Address = $Start << 3; + } + + # Address into the PLC + $myPDU[30] = $Address % 256; + $Address = $Address >> 8; + $myPDU[29] = $Address % 256; + $Address = $Address >> 8; + $myPDU[28] = $Address % 256; + + #transport size + my $bytesProElement; + + if ( $WordLen == &S7WLBit ) { + $myPDU[32] = &TS_ResBit; + $bytesProElement = 1; + } + + # elsif ($WordLen == &S7WLWord) { #V2.8 will be send as Bytes! + # $myPDU[32] = &TS_ResInt; + # $bytesProElement = 2; + # } + # elsif ($WordLen == &S7WLDWord) { + # $myPDU[32] = &TS_ResInt; + # $bytesProElement = 4; + # } + elsif ( $WordLen == &S7WLInt ) { + $myPDU[32] = &TS_ResInt; + $bytesProElement = 2; + } + elsif ( $WordLen == &S7WLDInt ) { + $myPDU[32] = &TS_ResInt; + $bytesProElement = 4; + } + elsif ( $WordLen == &S7WLReal ) { + $myPDU[32] = &TS_ResReal; + $bytesProElement = 4; + } + elsif ( $WordLen == &S7WLChar ) { + $myPDU[32] = &TS_ResOctet; + $bytesProElement = 1; + } + elsif ( $WordLen == &S7WLCounter ) { + $myPDU[32] = &TS_ResOctet; + $bytesProElement = 2; + } + elsif ( $WordLen == &S7WLTimer ) { + $myPDU[32] = &TS_ResOctet; + $bytesProElement = 2; + } + else { + $myPDU[32] = &TS_ResByte; + $bytesProElement = 1; + } + + if ( ( $myPDU[32] != &TS_ResOctet ) + && ( $myPDU[32] != &TS_ResReal ) + && ( $myPDU[32] != &TS_ResBit ) ) + { + $myLength = $DataSize << 3; + + } + else { + $myLength = $DataSize; + } + + # Num elements + my $nElements = int( $NumElements / $bytesProElement ); + $myPDU[23] = ( $nElements >> 8 ) % 256; + $myPDU[24] = ($nElements) % 256; + + #set word length + $myPDU[22] = $WordLen; + + # Length + $myPDU[33] = ( $myLength >> 8 ) % 256; + $myPDU[34] = $myLength % 256; + $self->{PDU}->{H} = pack( "C" x &Size_WR, @myPDU ); + + # Copy data + $self->{PDU}->{DATA} = substr( $ptrData, $Offset, $DataSize ); + + if ( $main::attr{global}{verbose} <= 5 ) { + my $b = join( + ", ", + unpack( + "H2 " x $IsoSize, + $self->{PDU}->{H} . $self->{PDU}->{DATA} + ) + ); + main::Log3 (undef, 5, + "TCPClient WriteArea (IP= " . $self->{Peer} . "): $b"); + } + if ( + $self->{TCPClient}->send( $self->{PDU}->{H} . $self->{PDU}->{DATA} ) + == $IsoSize ) + { + +# if (send($self->{TCPClient}, $self->{PDU}->{H}.$self->{PDU}->{DATA}, &MSG_NOSIGNAL)== $IsoSize) + ( $res, $myLength ) = $self->RecvISOPacket(); + if ( $self->{LastError} == 0 ) { + + if ( $myLength == 15 ) { + @myPDU = unpack( "C" x &Size_WR, $self->{PDU}->{H} ); + + if ( ( $myPDU[27] != 0x00 ) + || ( $myPDU[28] != 0x00 ) + || ( $myPDU[31] != 0xFF ) ) + { + $self->{LastError} = &errS7DataWrite; + + #CPU has sent an Error? + my $cpuErrorCode = $myPDU[31]; + my $error = $self->getCPUErrorStr($cpuErrorCode); + + my $msg = + "TCPClient WriteArea error: $cpuErrorCode = $error"; + main::Log3 (undef, 3, $msg); + + } + + } + else { + $self->{LastError} = &errS7InvalidPDU; + } + } + } + else { + $self->{LastError} = &errTCPDataSend; + } + + $Offset += $DataSize; + $TotElements -= $NumElements; + $Start += $NumElements * $WordSize; + } + return $self->{LastError}; +} + +#----------------------------------------------------------------------------- +sub getPLCDateTime() { + my ($self) = @_; + my $IsoSize; + my $res; + my $TotElements; + + main::Log3 (undef, 3, "TCPClient getPLCDateTime:"); + + # Setup the telegram + my @myPDU = unpack( "C" x &Size_DT, substr( $self->{S7_RW}, 0, &Size_DT ) ); + + # Whole telegram Size + # PDU Length + $IsoSize = &Size_DT; + + $myPDU[2] = ( $IsoSize >> 8 ) % 256; + $myPDU[3] = $IsoSize % 256; + + $myPDU[8] = 0x07; #job type = userdata + + $myPDU[9] = 0x00; # Redundancy identification + $myPDU[10] = 0x00; + + #set PDU Ref + my $myPDUID = $self->GetNextWord(); + $myPDU[11] = ( $myPDUID >> 8 ) % 256; + $myPDU[12] = $myPDUID % 256; + + #parameter length + $myPDU[13] = 0x00; + $myPDU[14] = 0x08; + + # Data Length + my $myLength = 4; + $myPDU[15] = ( $myLength >> 8 ) % 256; + $myPDU[16] = $myLength % 256; + + # Function + $myPDU[17] = 0x04; #read + + #set parameter heads + $myPDU[18] = 0x01; # Items count + $myPDU[19] = 0x12; # Var spec. + $myPDU[20] = 0x04; # Length of remaining bytes + $myPDU[21] = 0x11; # uk + $myPDU[22] = 0x47; # tg = grClock + $myPDU[23] = 0x01; #subfunction: Read Clock (Date and Time) + $myPDU[24] = 0x00; #Seq + + $self->{PDU}->{H} = + pack( "C" x &Size_DT, @myPDU ) . substr( $self->{PDU}->{H}, &Size_DT ); + + my $b = join( ", ", unpack( "H2 " x &Size_DT, $self->{PDU}->{H} ) ); + main::Log3 (undef, 3, + "TCPClient getPLCDateTime (IP= " . $self->{Peer} . "): $b"); + + $b = substr( $self->{PDU}->{H}, 0, &Size_DT ); + if ( $self->{TCPClient}->send($b) == &Size_DT ) { + + # main::Log3 undef, 3,"TCPClient getPLCDateTime request sent"; + ( $res, $myLength ) = $self->RecvISOPacket(); + main::Log3 (undef, 3, "TCPClient getPLCDateTime RecvISOPacket $res"); + if ( $self->{LastError} == 0 ) { + if ( $myLength >= 18 ) { + + @myPDU = unpack( "C" x $myLength, $self->{PDU}->{H} ); + my $b = join( + ", ", + unpack( + "H2 " x $myLength, + $self->{PDU}->{H} . $self->{PDU}->{DATA} + ) + ); + main::Log3 (undef, 3, + "TCPClient getPLCDateTime getPLCTime Result (IP= " + . $self->{Peer} . "): $b"); + + } + else { + $self->{LastError} = &errS7InvalidPDU; + main::Log3 (undef, 3, + "TCPClient getPLCDateTime errS7InvalidPDU length $myLength"); + + } + } + } + else { + $self->{LastError} = &errTCPDataSend; + main::Log3 (undef, 3, "TCPClient getPLCDateTime errTCPDataSend"); + } + return ( $self->{LastError}, 0 ); +} + +#----------------------------------------------------------------------------- + +sub version { + return "1.1"; +} + +#----------------------------------------------------------------------------- + +sub getErrorStr { + my ( $self, $errorCode ) = @_; + + if ( $errorCode == &errTCPConnectionFailed ) { + return "TCP Connection error"; + } + elsif ( $errorCode == &errTCPConnectionReset ) { + return "Connection reset by the peer"; + } + elsif ( $errorCode == &errTCPDataRecvTout ) { + return "A timeout occurred waiting a reply."; + } + elsif ( $errorCode == &errTCPDataSend ) { + return "Ethernet driver returned an error sending the data"; + } + elsif ( $errorCode == &errTCPDataRecv ) { + return "Ethernet driver returned an error receiving the data."; + } + elsif ( $errorCode == &errISOConnectionFailed ) { + return "ISO connection failed."; + } + elsif ( $errorCode == &errISONegotiatingPDU ) { + return "ISO PDU negotiation failed"; + } + elsif ( $errorCode == &errISOInvalidPDU ) { + return "Malformed PDU supplied."; + } + elsif ( $errorCode == &errS7InvalidPDU ) { return "Invalid PDU received."; } + elsif ( $errorCode == &errS7SendingPDU ) { return "Error sending a PDU."; } + elsif ( $errorCode == &errS7DataRead ) { return "Error during data read"; } + elsif ( $errorCode == &errS7DataWrite ) { + return "Error during data write"; + } + elsif ( $errorCode == &errS7Function ) { + return "The PLC reported an error for this function."; + } + elsif ( $errorCode == &errBufferTooSmall ) { + return "The buffer supplied is too small."; + } + else { return "unknown errorcode"; } + +} + +sub getCPUErrorStr { + my ( $self, $errorCode ) = @_; + + if ( $errorCode == &Code7Ok ) { return "CPU: OK"; } + elsif ( $errorCode == &Code7AddressOutOfRange ) { + return "CPU: AddressOutOfRange"; + } + elsif ( $errorCode == &Code7InvalidTransportSize ) { + return "CPU: Invalid Transport Size"; + } + elsif ( $errorCode == &Code7WriteDataSizeMismatch ) { + return "CPU: Write Data Size Mismatch"; + } + elsif ( $errorCode == &Code7ResItemNotAvailable ) { + return "CPU: ResItem Not Available"; + } + elsif ( $errorCode == &Code7ResItemNotAvailable1 ) { + return "CPU: ResItem Not Available1"; + } + elsif ( $errorCode == &Code7InvalidValue ) { return "CPU: Invalid Value"; } + elsif ( $errorCode == &Code7NeedPassword ) { return "CPU: Need Password"; } + elsif ( $errorCode == &Code7InvalidPassword ) { + return "CPU: Invalid Password"; + } + elsif ( $errorCode == &Code7NoPasswordToClear ) { + return "CPU: No Password To Clear"; + } + elsif ( $errorCode == &Code7NoPasswordToSet ) { + return "CPU: No Password To Set"; + } + elsif ( $errorCode == &Code7FunNotAvailable ) { + return "CPU: Fun Not Available"; + } + elsif ( $errorCode == &Code7DataOverPDU ) { return "CPU: DataOverPDU"; } + else { return "unknown errorcode"; } +} + +1; +=pod +=item summary low level interface to S7 +=item summary_DE low level interface to S7 + +=begin html + +

    +

    S7_S7Client

    +
      +
        low level interface to S7
      +
    + +=end html +=begin html_DE + +

    +

    S7_S7Client

    +
      +
        low level interface to S7
      +
    + +=end html_DE + +=cut \ No newline at end of file