2
0
mirror of https://github.com/fhem/fhem-mirror.git synced 2025-02-07 16:59:18 +00:00

SMUtils.pm: update to version 1.14.0

git-svn-id: https://svn.fhem.de/fhem/trunk@22903 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
nasseeder1 2020-10-03 20:31:54 +00:00
parent e8bc20a093
commit 460e7f7e86

View File

@ -41,12 +41,13 @@ use FHEM::SynoModules::ErrCodes qw(:all); # Erro
use GPUtils qw( GP_Import GP_Export ); use GPUtils qw( GP_Import GP_Export );
use Carp qw(croak carp); use Carp qw(croak carp);
use version; our $VERSION = version->declare('1.13.0'); use version; our $VERSION = version->declare('1.14.0');
use Exporter ('import'); use Exporter ('import');
our @EXPORT_OK = qw( our @EXPORT_OK = qw(
getClHash getClHash
delClHash delClHash
delReadings
trim trim
moduleVersion moduleVersion
sortVersion sortVersion
@ -96,22 +97,30 @@ BEGIN {
plotAsPng plotAsPng
RemoveInternalTimer RemoveInternalTimer
ReadingsVal ReadingsVal
ReadingsTimestamp
readingsSingleUpdate readingsSingleUpdate
readingsBeginUpdate readingsBeginUpdate
readingsBulkUpdate readingsBulkUpdate
readingsBulkUpdateIfChanged readingsBulkUpdateIfChanged
readingsEndUpdate readingsEndUpdate
readingsDelete
HttpUtils_NonblockingGet HttpUtils_NonblockingGet
) )
); );
}; };
# Standardvariablen # Standardvariablen
my $splitdef = ":"; # Standard Character für split ...
my $carpnohash = "got no hash value"; my $carpnohash = "got no hash value";
my $carpnoname = "got no name value"; my $carpnoname = "got no name value";
my $carpnoctyp = "got no credentials type"; my $carpnoctyp = "got no Credentials type code";
my $carpnoapir = "got no API Hash reference"; my $carpnoapir = "got no API Hash reference";
my $carpnotfn = "got no function name";
my $carpnotfarg = "got no Timer function argument"; my $carpnotfarg = "got no Timer function argument";
my $carpnoaddr = "got no server address from hash";
my $carpnoport = "got no server port from hash";
my $carpnoprot = "got no protocol from hash";
############################################################################### ###############################################################################
# Clienthash übernehmen oder zusammenstellen # Clienthash übernehmen oder zusammenstellen
@ -174,11 +183,45 @@ sub delClHash {
return; return;
} }
####################################################################################
# alle Readings außer excludierte löschen
# $respts -> Respect Timestamp
# wenn gesetzt, wird Reading nicht gelöscht
# wenn Updatezeit identisch zu "lastUpdate"
####################################################################################
sub delReadings {
my $name = shift // carp $carpnoname && return;
my $respts = shift;
my $hash = $defs{$name};
my $type = $hash->{TYPE};
my ($lu,$rts,$excl);
$excl = "Error|Errorcode|QueueLength|state|nextUpdate"; # Blacklist
$excl .= "|lastUpdate" if($respts);
my @allrds = keys%{$defs{$name}{READINGS}};
for my $key(@allrds) {
if($respts) {
$lu = $data{$type}{$name}{lastUpdate};
$rts = ReadingsTimestamp($name, $key, $lu);
next if($rts eq $lu);
}
readingsDelete($hash, $key) if($key !~ m/^$excl$/x);
}
return;
}
############################################################################### ###############################################################################
# Leerzeichen am Anfang / Ende eines strings entfernen # Leerzeichen am Anfang / Ende eines strings entfernen
############################################################################### ###############################################################################
sub trim { sub trim {
my $str = shift; my $str = shift;
return if(!$str);
$str =~ s/^\s+|\s+$//gx; $str =~ s/^\s+|\s+$//gx;
return $str; return $str;
@ -193,6 +236,15 @@ return $str;
# #
# Variablen $useAPI, $useSMUtils, $useErrCodes enthalten die Versionen von SynoModules # Variablen $useAPI, $useSMUtils, $useErrCodes enthalten die Versionen von SynoModules
# wenn verwendet und sind in diesem Fall zu übergeben. # wenn verwendet und sind in diesem Fall zu übergeben.
#
# Beispiel für Übergabe Parameter:
# my $params = {
# hash => $hash,
# notes => \%vNotesIntern,
# useAPI => 1,
# useSMUtils => 1,
# useErrCodes => 1
# };
############################################################################################# #############################################################################################
sub moduleVersion { sub moduleVersion {
my $paref = shift; my $paref = shift;
@ -361,14 +413,21 @@ return $ret;
############################################################################### ###############################################################################
# JSON Boolean Test und Mapping # JSON Boolean Test und Mapping
# $var = Variante der boolean Auswertung:
# "char": Rückgabe von true / false für wahr / falsch
# "bin" : Rückgabe von 1 / 0 für wahr / falsch
############################################################################### ###############################################################################
sub jboolmap { sub jboolmap {
my $bool = shift // carp "got no value to check if bool" && return; my $bool = shift // carp "got no value to check if bool" && return;
my $var = shift // "char";
my $true = ($var eq "char") ? "true" : 1;
my $false = ($var eq "char") ? "false" : 0;
my $is_boolean = JSON::is_bool($bool); my $is_boolean = JSON::is_bool($bool);
if($is_boolean) { if($is_boolean) {
$bool = $bool ? "true" : "false"; $bool = $bool ? $true : $false;
} }
return $bool; return $bool;
@ -477,19 +536,21 @@ return;
###################################################################################### ######################################################################################
# Username / Paßwort speichern # Username / Paßwort speichern
# $ao = "credentials" -> Standard Credentials # $ctc = "credentials" -> Standard Credentials
# $ao = "SMTPcredentials" -> Credentials für Mailversand # $ctc = "SMTPcredentials" -> Credentials für Mailversand
# $sep = Separator zum Split des $credstr, default ":"
###################################################################################### ######################################################################################
sub setCredentials { sub setCredentials {
my $hash = shift // carp $carpnohash && return; my $hash = shift // carp $carpnohash && return;
my $ao = shift // carp $carpnoctyp && return; my $ctc = shift // carp $carpnoctyp && return;
my $user = shift // carp "got no user name" && return; my $user = shift // carp "got no user name" && return;
my $pass = shift // carp "got no password" && return; my $pass = shift // carp "got no password" && return;
my $sep = shift // $splitdef;
my $name = $hash->{NAME}; my $name = $hash->{NAME};
my $success; my $success;
my $credstr = encode_base64 ("$user:$pass"); my $credstr = encode_base64 ($user.$sep.$pass);
# Beginn Scramble-Routine # Beginn Scramble-Routine
my @key = qw(1 3 4 5 6 3 2 1 9); my @key = qw(1 3 4 5 6 3 2 1 9);
@ -498,7 +559,7 @@ sub setCredentials {
$credstr = join "", map { $i = ($i + 1) % $len; chr((ord($_) + $key[$i]) % 256) } split //, $credstr; ## no critic 'Map blocks'; $credstr = join "", map { $i = ($i + 1) % $len; chr((ord($_) + $key[$i]) % 256) } split //, $credstr; ## no critic 'Map blocks';
# End Scramble-Routine # End Scramble-Routine
my $index = $hash->{TYPE}."_".$hash->{NAME}."_".$ao; my $index = $hash->{TYPE}."_".$hash->{NAME}."_".$ctc;
my $retcode = setKeyValue($index, $credstr); my $retcode = setKeyValue($index, $credstr);
if ($retcode) { if ($retcode) {
@ -506,7 +567,7 @@ sub setCredentials {
$success = 0; $success = 0;
} }
else { else {
getCredentials($hash,1,$ao); # Credentials nach Speicherung lesen und in RAM laden ($boot=1), $ao = credentials oder SMTPcredentials getCredentials($hash,1,$ctc,$sep); # Credentials nach Speicherung lesen und in RAM laden ($boot=1), $ao = credentials oder SMTPcredentials
$success = 1; $success = 1;
} }
@ -515,35 +576,45 @@ return ($success);
###################################################################################### ######################################################################################
# Username / Paßwort abrufen # Username / Paßwort abrufen
# $ao = "credentials" -> Standard Credentials # $boot = 1 beim erstmaligen laden
# $ao = "SMTPcredentials" -> Credentials für Mailversand # $ctc = "credentials" -> Standard Credentials
# $ctc = "SMTPcredentials" -> Credentials für Mailversand
# $sep = Separator zum Split des $credstr, default ":"
###################################################################################### ######################################################################################
sub getCredentials { sub getCredentials {
my $hash = shift // carp $carpnohash && return; my $hash = shift // carp $carpnohash && return;
my $boot = shift; my $boot = shift;
my $ao = shift // carp $carpnoctyp && return; my $ctc = shift // carp $carpnoctyp && return;
my $sep = shift // $splitdef;
my $name = $hash->{NAME}; my $name = $hash->{NAME};
my ($success, $username, $passwd, $index, $retcode, $credstr);
my (@key,$len,$i);
my $pp; my ($success, $username, $passwd, $index, $retcode, $credstr,$pp,$err);
if ($boot) { # mit $boot=1 Credentials von Platte lesen und als scrambled-String in RAM legen if ($boot) { # mit $boot=1 Credentials von Platte lesen und als scrambled-String in RAM legen
$index = $hash->{TYPE}."_".$hash->{NAME}."_".$ao; $index = $hash->{TYPE}."_".$hash->{NAME}."_".$ctc;
($retcode, $credstr) = getKeyValue($index); ($retcode, $credstr) = getKeyValue($index);
if ($retcode) { if ($retcode) {
Log3($name, 2, "$name - Unable to read password from file: $retcode"); Log3($name, 2, "$name - ERROR - Unable to read Credentials from file: $retcode");
$success = 0; $success = 0;
} }
if ($credstr) { if ($credstr) {
if($ao eq "credentials") { # beim Boot scrambled Credentials in den RAM laden ($username, $passwd) = split "$sep", decode_base64( descramble($credstr) );
if(!$username || !$passwd) {
($err,$pp) = getCredentialsFromHash ($hash, $ctc); # nur Error und Credetials Shortcut lesen !
$err = $err ? $err : qq{possible problem in splitting with separator "$sep"};
Log3($name, 2, "$name - ERROR - ".$pp."Credentials not successfully decoded ! $err");
return 0;
}
if($ctc eq "credentials") { # beim Boot scrambled Credentials in den RAM laden
$hash->{HELPER}{CREDENTIALS} = $credstr; $hash->{HELPER}{CREDENTIALS} = $credstr;
$hash->{CREDENTIALS} = "Set"; # "Credentials" wird als Statusbit ausgewertet. Wenn nicht gesetzt -> Warnmeldung und keine weitere Verarbeitung $hash->{CREDENTIALS} = "Set"; # "Credentials" wird als Statusbit ausgewertet. Wenn nicht gesetzt -> Warnmeldung und keine weitere Verarbeitung
$success = 1; $success = 1;
}
} elsif ($ao eq "SMTPcredentials") { # beim Boot scrambled Credentials in den RAM laden elsif ($ctc eq "SMTPcredentials") { # beim Boot scrambled Credentials in den RAM laden
$hash->{HELPER}{SMTPCREDENTIALS} = $credstr; $hash->{HELPER}{SMTPCREDENTIALS} = $credstr;
$hash->{SMTPCREDENTIALS} = "Set"; # "Credentials" wird als Statusbit ausgewertet. Wenn nicht gesetzt -> Warnmeldung und keine weitere Verarbeitung $hash->{SMTPCREDENTIALS} = "Set"; # "Credentials" wird als Statusbit ausgewertet. Wenn nicht gesetzt -> Warnmeldung und keine weitere Verarbeitung
$success = 1; $success = 1;
@ -551,40 +622,69 @@ sub getCredentials {
} }
} }
else { # boot = 0 -> Credentials aus RAM lesen, decoden und zurückgeben else { # boot = 0 -> Credentials aus RAM lesen, decoden und zurückgeben
if ($ao eq "credentials") { ($err,$pp,$credstr) = getCredentialsFromHash ($hash, $ctc);
$credstr = $hash->{HELPER}{CREDENTIALS};
$pp = q{};
} elsif ($ao eq "SMTPcredentials") { if(!$err && $credstr) {
$pp = q{SMTP}; ($username, $passwd) = split "$sep", decode_base64( descramble($credstr) );
$credstr = $hash->{HELPER}{SMTPCREDENTIALS};
if(!$username || !$passwd) {
$err = qq{possible problem in splitting with separator "$sep"};
Log3($name, 2, "$name - ERROR - ".$pp."Credentials not successfully decoded ! $err");
delete $hash->{CREDENTIALS};
} }
if($credstr) { my $logpw = AttrVal($name, "showPassInLog", 0) ? $passwd // "" : "********";
# Beginn Descramble-Routine
@key = qw(1 3 4 5 6 3 2 1 9);
$len = scalar @key;
$i = 0;
$credstr = join "",
map { $i = ($i + 1) % $len; chr((ord($_) - $key[$i] + 256) % 256) } split //, $credstr; ## no critic 'Map blocks';
# Ende Descramble-Routine
($username, $passwd) = split ":",decode_base64($credstr);
my $logpw = AttrVal($name, "showPassInLog", 0) ? $passwd : "********";
Log3($name, 4, "$name - ".$pp."Credentials read from RAM: $username $logpw"); Log3($name, 4, "$name - ".$pp."Credentials read from RAM: $username $logpw");
} }
else { else {
Log3($name, 2, "$name - ".$pp."Credentials not set in RAM !"); Log3($name, 2, "$name - ERROR - ".$pp."Credentials not set in RAM ! $err");
} }
$success = (defined $passwd) ? 1 : 0; $success = ($username && $passwd) ? 1 : 0;
} }
return ($success, $username, $passwd); return ($success, $username, $passwd);
} }
###############################################################################
# entpackt einen mit enscramble behandelten String
###############################################################################
sub descramble {
my $sstr = shift // carp "got no string to descramble" && return;
my @key = qw(1 3 4 5 6 3 2 1 9);
my $len = scalar @key;
my $i = 0;
my $dstr = join "", map { $i = ($i + 1) % $len; chr((ord($_) - $key[$i] + 256) % 256) } split //, $sstr; ## no critic 'Map blocks';
return $dstr;
}
###############################################################################
# liefert Kürzel eines Credentials und den Credetialstring aus dem Hash
# $ctc = Credentials Type Code
###############################################################################
sub getCredentialsFromHash {
my $hash = shift // carp $carpnohash && return;
my $ctc = shift // carp "got no Credentials type code" && return;
my $credstr = q{};
my $pp = q{};
my $err = "no shortcut found for Credential type code: $ctc";
if ($ctc eq "credentials") {
$credstr = $hash->{HELPER}{CREDENTIALS};
$err = q{};
}
elsif ($ctc eq "SMTPcredentials") {
$pp = q{SMTP};
$credstr = $hash->{HELPER}{SMTPCREDENTIALS};
$err = q{};
}
return ($err,$pp,$credstr);
}
############################################################################### ###############################################################################
# Test ob JSON-String vorliegt # Test ob JSON-String vorliegt
@ -629,19 +729,24 @@ return ($success,$myjson);
#################################################################################### ####################################################################################
# Login wenn keine oder ungültige Session-ID vorhanden ist # Login wenn keine oder ungültige Session-ID vorhanden ist
# $apiref = Referenz zum API Hash # $apiref = Referenz zum API Hash
# $fret = Rückkehrfunktion nach erfolgreichen Login # $fret = Referenz zur Rückkehrfunktion nach erfolgreichen Login
# $fretarg = Argument für Rückkehrfunktion, default: $hash
# $sep = Separator für split Credentials in getCredentials, default ":"
#################################################################################### ####################################################################################
sub login { sub login {
my $hash = shift // carp $carpnohash && return; my $hash = shift // carp $carpnohash && return;
my $apiref = shift // carp $carpnoapir && return; my $apiref = shift // carp $carpnoapir && return;
my $fret = shift // carp "got no return function reference" && return; my $fret = shift // carp "got no return function reference" && return;
my $fretarg = shift // $hash;
my $sep = shift // $splitdef;
my $serveraddr = $hash->{SERVERADDR} // carp $carpnoaddr && return;
my $serverport = $hash->{SERVERPORT} // carp $carpnoport && return;
my $proto = $hash->{PROTOCOL} // carp $carpnoprot && return;
my $name = $hash->{NAME}; my $name = $hash->{NAME};
my $serveraddr = $hash->{SERVERADDR};
my $serverport = $hash->{SERVERPORT};
my $apiauth = $apiref->{AUTH}{NAME}; my $apiauth = $apiref->{AUTH}{NAME};
my $apiauthpath = $apiref->{AUTH}{PATH}; my $apiauthpath = $apiref->{AUTH}{PATH};
my $apiauthver = $apiref->{AUTH}{VER}; my $apiauthver = $apiref->{AUTH}{VER};
my $proto = $hash->{PROTOCOL};
my $type = $hash->{TYPE}; my $type = $hash->{TYPE};
my ($url,$param,$urlwopw); my ($url,$param,$urlwopw);
@ -650,10 +755,10 @@ sub login {
Log3($name, 4, "$name - --- Begin Function login ---"); Log3($name, 4, "$name - --- Begin Function login ---");
my ($success, $username, $password) = getCredentials($hash,0,"credentials"); # Credentials abrufen my ($success, $username, $password) = getCredentials($hash,0,"credentials",$sep); # Credentials abrufen
if (!$success) { if (!$success) {
Log3($name, 2, "$name - Credentials couldn't be retrieved successfully - make sure you've set it with \"set $name credentials <username> <password>\""); Log3($name, 2, qq{$name - Credentials couldn't be retrieved successfully - make sure you've set it with "set $name credentials <username> <password>"});
delActiveToken($hash) if($type eq "SSCam"); delActiveToken($hash) if($type eq "SSCam");
return; return;
} }
@ -669,6 +774,7 @@ sub login {
my $timeout = AttrVal($name,"timeout",60); # Kompatibilität zu Modulen die das Attr "timeout" verwenden my $timeout = AttrVal($name,"timeout",60); # Kompatibilität zu Modulen die das Attr "timeout" verwenden
my $httptimeout = AttrVal($name,"httptimeout",$timeout); my $httptimeout = AttrVal($name,"httptimeout",$timeout);
$httptimeout = 60 if($httptimeout < 60); $httptimeout = 60 if($httptimeout < 60);
Log3($name, 4, "$name - HTTP-Call login will be done with httptimeout-Value: $httptimeout s"); Log3($name, 4, "$name - HTTP-Call login will be done with httptimeout-Value: $httptimeout s");
my $sid = AttrVal($name, "noQuotesForSID", 0) ? "sid" : qq{"sid"}; # sid in Quotes einschliessen oder nicht -> bei Problemen mit 402 - Permission denied my $sid = AttrVal($name, "noQuotesForSID", 0) ? "sid" : qq{"sid"}; # sid in Quotes einschliessen oder nicht -> bei Problemen mit 402 - Permission denied
@ -692,7 +798,9 @@ sub login {
timeout => $httptimeout, timeout => $httptimeout,
hash => $hash, hash => $hash,
user => $username, user => $username,
funcret => $fret, fret => $fret,
fretarg => $fretarg,
sep => $sep,
apiref => $apiref, apiref => $apiref,
method => "GET", method => "GET",
header => "Accept: application/json", header => "Accept: application/json",
@ -709,9 +817,12 @@ sub loginReturn {
my $err = shift; my $err = shift;
my $myjson = shift; my $myjson = shift;
my $hash = $param->{hash}; my $hash = $param->{hash};
my $name = $hash->{NAME}; my $name = $hash->{NAME};
my $username = $param->{user}; my $username = $param->{user};
my $fret = $param->{funcret}; my $fret = $param->{fret};
my $fretarg = $param->{fretarg};
my $sep = $param->{sep};
my $apiref = $param->{apiref}; my $apiref = $param->{apiref};
my $type = $hash->{TYPE}; my $type = $hash->{TYPE};
@ -722,10 +833,11 @@ sub loginReturn {
readingsSingleUpdate($hash, "Error", $err, 1); readingsSingleUpdate($hash, "Error", $err, 1);
return login($hash,$apiref,$fret); return login($hash,$apiref,$fret,$fretarg,$sep);
} elsif ($myjson ne "") { # wenn die Abfrage erfolgreich war ($data enthält die Ergebnisdaten des HTTP Aufrufes) } elsif ($myjson ne "") { # wenn die Abfrage erfolgreich war ($data enthält die Ergebnisdaten des HTTP Aufrufes)
($success) = evaljson($hash,$myjson); # Evaluiere ob Daten im JSON-Format empfangen wurden ($success) = evaljson($hash,$myjson); # Evaluiere ob Daten im JSON-Format empfangen wurden
if (!$success) { if (!$success) {
Log3($name, 4, "$name - no JSON-Data returned: ".$myjson); Log3($name, 4, "$name - no JSON-Data returned: ".$myjson);
delActiveToken($hash) if($type eq "SSCam"); delActiveToken($hash) if($type eq "SSCam");
@ -750,7 +862,7 @@ sub loginReturn {
Log3($name, 4, "$name - Login of User $username successful - SID: $sid"); Log3($name, 4, "$name - Login of User $username successful - SID: $sid");
return &$fret($hash); return &$fret($fretarg);
} }
else { else {
my $errorcode = $data->{'error'}->{'code'}; # Errorcode aus JSON ermitteln my $errorcode = $data->{'error'}->{'code'}; # Errorcode aus JSON ermitteln
@ -759,38 +871,63 @@ sub loginReturn {
readingsBeginUpdate ($hash); readingsBeginUpdate ($hash);
readingsBulkUpdate ($hash, "Errorcode", $errorcode ); readingsBulkUpdate ($hash, "Errorcode", $errorcode );
readingsBulkUpdate ($hash, "Error", $error ); readingsBulkUpdate ($hash, "Error", $error );
readingsBulkUpdate ($hash, "state", "login Error");
readingsEndUpdate ($hash, 1); readingsEndUpdate ($hash, 1);
Log3($name, 3, "$name - Login of User $username unsuccessful. Code: $errorcode - $error - try again"); Log3($name, 3, "$name - Login of User $username unsuccessful. Code: $errorcode - $error - try again");
return login($hash,$apiref,$fret); return login($hash,$apiref,$fret,$fretarg,$sep);
} }
} }
return login($hash,$apiref,$fret); return login($hash,$apiref,$fret,$fretarg,$sep);
} }
################################################################################### ###################################################################################
# Funktion logout # Funktion logout
# $apiref = Referenz zum API Hash
# $sep = Separator für split Credentials in getCredentials, default ":"
################################################################################### ###################################################################################
sub logout { sub logout {
my $hash = shift // carp $carpnohash && return; my $hash = shift // carp $carpnohash && return;
my $apiref = shift // carp $carpnoapir && return; my $apiref = shift // carp $carpnoapir && return;
my $sep = shift // $splitdef;
my $name = $hash->{NAME}; my $name = $hash->{NAME};
my $serveraddr = $hash->{SERVERADDR}; my $serveraddr = $hash->{SERVERADDR};
my $serverport = $hash->{SERVERPORT}; my $serverport = $hash->{SERVERPORT};
my $proto = $hash->{PROTOCOL};
my $type = $hash->{TYPE};
my $apiauth = $apiref->{AUTH}{NAME}; my $apiauth = $apiref->{AUTH}{NAME};
my $apiauthpath = $apiref->{AUTH}{PATH}; my $apiauthpath = $apiref->{AUTH}{PATH};
my $apiauthver = $apiref->{AUTH}{VER}; my $apiauthver = $apiref->{AUTH}{VER};
my $sid = $hash->{HELPER}{SID};
my $proto = $hash->{PROTOCOL}; my $sid = delete $hash->{HELPER}{SID} // q{};
my $url; my $url;
Log3($name, 4, "$name - --- Start Synology logout ---"); Log3($name, 4, "$name - --- Start Synology logout ---");
my $httptimeout = AttrVal($name,"httptimeout",4); my ($success, $username) = getCredentials($hash,0,"credentials",$sep);
Log3($name, 5, "$name - HTTP-Call will be done with httptimeout-Value: $httptimeout s");
if(!$sid) {
Log3($name, 2, qq{$name - User "$username" has no valid session, logout is cancelled});
readingsBeginUpdate ($hash);
readingsBulkUpdate ($hash, "Errorcode", "none");
readingsBulkUpdate ($hash, "Error", "none");
readingsBulkUpdate ($hash, "state", "logout done");
readingsEndUpdate ($hash, 1);
delActiveToken ($hash) if($type eq "SSCam"); # ausgeführte Funktion ist erledigt (auch wenn logout nicht erfolgreich), Freigabe Funktionstoken
CancelDelayedShutdown ($name);
return;
}
my $timeout = AttrVal($name,"timeout",60);
$timeout = 60 if($timeout < 60);
Log3($name, 5, "$name - Call logout will be done with timeout value: $timeout s");
if (AttrVal($name,"session","DSM") eq "DSM") { if (AttrVal($name,"session","DSM") eq "DSM") {
$url = "$proto://$serveraddr:$serverport/webapi/$apiauthpath?api=$apiauth&version=$apiauthver&method=Logout&_sid=$sid"; $url = "$proto://$serveraddr:$serverport/webapi/$apiauthpath?api=$apiauth&version=$apiauthver&method=Logout&_sid=$sid";
@ -801,8 +938,10 @@ sub logout {
my $param = { my $param = {
url => $url, url => $url,
timeout => $httptimeout, timeout => $timeout,
hash => $hash, hash => $hash,
sid => $sid,
username => $username,
method => "GET", method => "GET",
header => "Accept: application/json", header => "Accept: application/json",
callback => \&logoutReturn callback => \&logoutReturn
@ -818,11 +957,11 @@ sub logoutReturn {
my $err = shift; my $err = shift;
my $myjson = shift; my $myjson = shift;
my $hash = $param->{hash}; my $hash = $param->{hash};
my $name = $hash->{NAME}; my $sid = $param->{sid};
my $sid = $hash->{HELPER}{SID}; my $username = $param->{username};
my $type = $hash->{TYPE};
my ($success, $username) = getCredentials($hash,0,"credentials"); my $name = $hash->{NAME};
my $type = $hash->{TYPE};
if ($err ne "") { # wenn ein Fehler bei der HTTP Abfrage aufgetreten ist if ($err ne "") { # wenn ein Fehler bei der HTTP Abfrage aufgetreten ist
Log3($name, 2, "$name - error while requesting ".$param->{url}." - $err"); Log3($name, 2, "$name - error while requesting ".$param->{url}." - $err");
@ -831,7 +970,7 @@ sub logoutReturn {
} elsif ($myjson ne "") { # wenn die Abfrage erfolgreich war ($data enthält die Ergebnisdaten des HTTP Aufrufes) } elsif ($myjson ne "") { # wenn die Abfrage erfolgreich war ($data enthält die Ergebnisdaten des HTTP Aufrufes)
Log3($name, 4, "$name - URL-Call: ".$param->{url}); Log3($name, 4, "$name - URL-Call: ".$param->{url});
($success) = evaljson($hash,$myjson); # Evaluiere ob Daten im JSON-Format empfangen wurden my ($success) = evaljson($hash,$myjson); # Evaluiere ob Daten im JSON-Format empfangen wurden
if (!$success) { if (!$success) {
Log3($name, 4, "$name - Data returned: ".$myjson); Log3($name, 4, "$name - Data returned: ".$myjson);
@ -846,20 +985,23 @@ sub logoutReturn {
$success = $data->{'success'}; $success = $data->{'success'};
if ($success) { # die Logout-URL konnte erfolgreich aufgerufen werden if ($success) { # die Logout-URL konnte erfolgreich aufgerufen werden
Log3($name, 2, "$name - Session of User \"$username\" terminated - session ID \"$sid\" deleted"); readingsBeginUpdate ($hash);
readingsBulkUpdate ($hash, "Errorcode", "none");
readingsBulkUpdate ($hash, "Error", "none");
readingsBulkUpdate ($hash, "state", "logout done");
readingsEndUpdate ($hash, 1);
Log3($name, 2, qq{$name - Session of User "$username" terminated - session ID "$sid" deleted});
} }
else { else {
my $errorcode = $data->{'error'}->{'code'}; # Errorcode aus JSON ermitteln my $errorcode = $data->{'error'}->{'code'}; # Errorcode aus JSON ermitteln
my $error = expErrorsAuth($hash,$errorcode); # Fehlertext zum Errorcode ermitteln my $error = expErrorsAuth($hash,$errorcode); # Fehlertext zum Errorcode ermitteln
Log3($name, 2, "$name - ERROR - Logout of User $username was not successful, however SID: \"$sid\" has been deleted. Errorcode: $errorcode - $error"); Log3($name, 2, qq{$name - ERROR - Logout of User $username was not successful, however SID: "$sid" has been deleted. Errorcode: $errorcode - $error});
} }
} }
delete $hash->{HELPER}{SID}; # Session-ID aus Helper-hash löschen delActiveToken ($hash) if($type eq "SSCam"); # ausgeführte Funktion ist erledigt (auch wenn logout nicht erfolgreich), Freigabe Funktionstoken
delActiveToken($hash); # ausgeführte Funktion ist erledigt (auch wenn logout nicht erfolgreich), Freigabe Funktionstoken
CancelDelayedShutdown ($name); CancelDelayedShutdown ($name);
return; return;
@ -919,7 +1061,7 @@ return;
############################################################################################# #############################################################################################
sub setReadingErrorNone { sub setReadingErrorNone {
my $hash = shift // carp $carpnohash && return; my $hash = shift // carp $carpnohash && return;
my $evt = shift; my $evt = shift // 0;
readingsBeginUpdate($hash); readingsBeginUpdate($hash);
readingsBulkUpdate ($hash, "Errorcode", "none"); readingsBulkUpdate ($hash, "Errorcode", "none");
@ -1004,15 +1146,15 @@ return $sq;
############################################################################################# #############################################################################################
# Funktion Zeitplan löschen und neu planen # Funktion Zeitplan löschen und neu planen
# $rst = restart Timer # $rst = Zeit für Funktionseinplanung
# $startfn = Funktion deren Timer gelöscht und neu gestartet werdene soll # $startfn = Funktion (Name incl. Paket) deren Timer gelöscht und neu gestartet wird
# $arg = Argument für die Timer Funktion # $arg = Argument für die Timer Funktion
############################################################################################# #############################################################################################
sub startFunctionDelayed { sub startFunctionDelayed {
my $name = shift // carp $carpnoname && return; my $name = shift // carp $carpnoname && return;
my $rst = shift // carp "got no restart Timer value" && return; my $rst = shift // carp "got no restart Timer value" && return;
my $startfn = shift // carp $carpnotfarg && return; my $startfn = shift // carp $carpnotfn && return;
my $arg = shift // carp "got no Timer function argument" && return; my $arg = shift // carp $carpnotfarg && return;
RemoveInternalTimer ($arg, $startfn); RemoveInternalTimer ($arg, $startfn);
InternalTimer ($rst, $startfn, $arg, 0); InternalTimer ($rst, $startfn, $arg, 0);
@ -1023,23 +1165,25 @@ return;
############################################################################################# #############################################################################################
# Erfolg der Abarbeitung eines Queueeintrags checken und ggf. Retry ausführen # Erfolg der Abarbeitung eines Queueeintrags checken und ggf. Retry ausführen
# bzw. den SendQueue-Eintrag bei Erfolg löschen # bzw. den SendQueue-Eintrag bei Erfolg löschen
# $name = Name des Chatbot-Devices # $name = Name des Devices
# $retry = 0 -> Opmode erfolgreich (DS löschen), # $retry = 0 -> Opmode erfolgreich (DS löschen),
# 1 -> Opmode nicht erfolgreich (Abarbeitung nach ckeck errorcode # 1 -> Opmode nicht erfolgreich (Abarbeitung nach ckeck errorcode
# eventuell verzögert wiederholen) # eventuell verzögert wiederholen)
# $startfnref = Referenz zur Funktion die nach Check ggf. gestartet werden soll # $startfn = Funktion (Name incl. Paket) die nach Check ggf. gestartet werden soll
############################################################################################# #############################################################################################
sub checkSendRetry { sub checkSendRetry {
my $name = shift // carp $carpnoname && return; my $name = shift // carp $carpnoname && return;
my $retry = shift // carp "got opmode state" && return; my $retry = shift // carp "got no opmode state" && return;
my $startfn = shift // carp $carpnotfarg && return; my $startfn = shift // carp $carpnotfn && return;
my $hash = $defs{$name}; my $hash = $defs{$name};
my $idx = $hash->{OPIDX}; my $idx = $hash->{OPIDX};
my $type = $hash->{TYPE}; my $type = $hash->{TYPE};
my $forbidSend = ""; my $forbidSend = q{};
my $startfnref = \&{$startfn}; my $startfnref = \&{$startfn};
my @forbidlist = qw(100 101 103 117 120 407 409 410 800 900); # bei diesen Errorcodes den Queueeintrag nicht wiederholen, da dauerhafter Fehler !
if(!keys %{$data{$type}{$name}{sendqueue}{entries}}) { if(!keys %{$data{$type}{$name}{sendqueue}{entries}}) {
Log3($name, 4, "$name - SendQueue is empty. Nothing to do ..."); Log3($name, 4, "$name - SendQueue is empty. Nothing to do ...");
updQueueLength ($hash); updQueueLength ($hash);
@ -1062,11 +1206,16 @@ sub checkSendRetry {
my $rc = $data{$type}{$name}{sendqueue}{entries}{$idx}{retryCount}; my $rc = $data{$type}{$name}{sendqueue}{entries}{$idx}{retryCount};
my $errorcode = ReadingsVal($name, "Errorcode", 0); my $errorcode = ReadingsVal($name, "Errorcode", 0);
if($errorcode =~ /100|101|117|120|407|409|410|800/x) { # bei diesen Errorcodes den Queueeintrag nicht wiederholen, da dauerhafter Fehler !
if($errorcode =~ /119/x) { # Session wird neu requestet und Queue-Eintrag wiederholt
delete $hash->{HELPER}{SID};
}
if(grep { $_ eq $errorcode } @forbidlist) {
$forbidSend = expErrors($hash,$errorcode); # Fehlertext zum Errorcode ermitteln $forbidSend = expErrors($hash,$errorcode); # Fehlertext zum Errorcode ermitteln
$data{$type}{$name}{sendqueue}{entries}{$idx}{forbidSend} = $forbidSend; $data{$type}{$name}{sendqueue}{entries}{$idx}{forbidSend} = $forbidSend;
Log3($name, 2, "$name - ERROR - \"$hash->{OPMODE}\" SendQueue index \"$idx\" not executed. It seems to be a permanent error. Exclude it from new send attempt !"); Log3($name, 2, qq{$name - ERROR - "$hash->{OPMODE}" SendQueue index "$idx" not executed. It seems to be a permanent error. Exclude it from new send attempt !});
delete $hash->{OPIDX}; delete $hash->{OPIDX};
delete $hash->{OPMODE}; delete $hash->{OPMODE};
@ -1086,7 +1235,7 @@ sub checkSendRetry {
: 86400 : 86400
; ;
Log3($name, 2, "$name - ERROR - \"$hash->{OPMODE}\" SendQueue index \"$idx\" not executed. Restart SendQueue in $rs seconds (retryCount $rc)."); Log3($name, 2, qq{$name - ERROR - "$hash->{OPMODE}" SendQueue index "$idx" not executed. Restart SendQueue in $rs s (retryCount $rc).});
my $rst = gettimeofday()+$rs; # resend Timer my $rst = gettimeofday()+$rs; # resend Timer
updQueueLength ($hash,$rst); # updaten Länge der Sendequeue mit resend Timer updQueueLength ($hash,$rst); # updaten Länge der Sendequeue mit resend Timer
@ -1140,18 +1289,15 @@ sub updQueueLength {
my $type = $hash->{TYPE}; my $type = $hash->{TYPE};
my $ql = keys %{$data{$type}{$name}{sendqueue}{entries}}; my $ql = keys %{$data{$type}{$name}{sendqueue}{entries}};
readingsDelete ($hash, "QueueLenth"); # entferne Reading mit Typo
readingsBeginUpdate ($hash); readingsBeginUpdate ($hash);
readingsBulkUpdateIfChanged ($hash, "QueueLenth", $ql); # Länge Sendqueue updaten readingsBulkUpdateIfChanged ($hash, "QueueLength", $ql); # Länge Sendqueue updaten
readingsEndUpdate ($hash,1); readingsEndUpdate ($hash,1);
my $head = "next planned SendQueue start:"; my $head = "next planned SendQueue start:";
if($rst) { # resend Timer gesetzt $hash->{RESEND} = $rst ? $head." ".FmtDateTime($rst) : $head." immediately by next entry";
$hash->{RESEND} = $head." ".FmtDateTime($rst);
}
else {
$hash->{RESEND} = $head." immediately by next entry";
}
return; return;
} }