98_HTTPMOD: small bug fixes

git-svn-id: https://svn.fhem.de/fhem/trunk/fhem@24678 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
StefanStrobel 2021-06-24 19:45:06 +00:00
parent 399ea4a166
commit edfb043a69
2 changed files with 12 additions and 7 deletions

View File

@ -140,7 +140,7 @@ BEGIN {
)); ));
}; };
my $Module_Version = '4.1.08 - 1.4.2021'; my $Module_Version = '4.1.09 - 24.6.2021';
my $AttrList = join (' ', my $AttrList = join (' ',
'(reading|get|set)[0-9]+(-[0-9]+)?Name', '(reading|get|set)[0-9]+(-[0-9]+)?Name',
@ -2151,7 +2151,7 @@ sub CheckRedirects {
Log3 $name, 4, "$name: no header to look for redirects"; Log3 $name, 4, "$name: no header to look for redirects";
return; return;
} }
my @header = split("\r\n", $header); my @header = split("[\r\n]+", $header);
my @header0 = split(" ", shift @header); my @header0 = split(" ", shift @header);
my $code = $header0[1]; my $code = $header0[1];
Log3 $name, 4, "$name: checking for redirects, code=$code, ignore=$request->{ignoreredirects}"; Log3 $name, 4, "$name: checking for redirects, code=$code, ignore=$request->{ignoreredirects}";
@ -2171,6 +2171,7 @@ sub CheckRedirects {
map { $redirAdr = $1 if ( $_ =~ m{ [Ll]ocation: \s* (\S+) $ }xms ) } @header; map { $redirAdr = $1 if ( $_ =~ m{ [Ll]ocation: \s* (\S+) $ }xms ) } @header;
if (!$redirAdr) { if (!$redirAdr) {
Log3 $name, 3, "$name: Error: got Redirect but no Location-Header from server"; Log3 $name, 3, "$name: Error: got Redirect but no Location-Header from server";
return;
} }
$redirAdr = "/$redirAdr" if($redirAdr !~ m/^http/ && $redirAdr !~ m/^\//); $redirAdr = "/$redirAdr" if($redirAdr !~ m/^http/ && $redirAdr !~ m/^\//);
my $rurl = ($redirAdr =~ m/^http/) ? $redirAdr : $addr.$redirAdr; my $rurl = ($redirAdr =~ m/^http/) ? $redirAdr : $addr.$redirAdr;

View File

@ -18,7 +18,11 @@
# along with fhem. If not, see <http://www.gnu.org/licenses/>. # along with fhem. If not, see <http://www.gnu.org/licenses/>.
# #
############################################################################## ##############################################################################
#
# todo: rights checking for eval
# timeout functions
#
package FHEM::HTTPMOD::Utils; package FHEM::HTTPMOD::Utils;
use strict; use strict;
@ -245,7 +249,7 @@ sub ValidRegex {
# #
# var names can not only start with % but also @ and $ # var names can not only start with % but also @ and $
# when a hash is passed and the target variable name starts with $ # when a hash is passed and the target variable name starts with $
# then it is assigned the hash reference not a new copy of the hash # then it is assigned the hash reference not a new copy of the hash.
# same for arrays. # same for arrays.
# #
# special keys: # special keys:
@ -561,7 +565,7 @@ sub StoreKeyValue {
my $key = getUniqueId().$index; my $key = getUniqueId().$index;
my $enc = ""; my $enc = "";
if(eval { use Digest::MD5; 1 }) { if(eval "use Digest::MD5; 1") {
$key = Digest::MD5::md5_hex(unpack "H*", $key); $key = Digest::MD5::md5_hex(unpack "H*", $key);
$key .= Digest::MD5::md5_hex($key); $key .= Digest::MD5::md5_hex($key);
} }
@ -598,7 +602,7 @@ sub ReadKeyValue {
Log3 $name, 4, "$name: ReadKeyValue could not find key $kName in file"; Log3 $name, 4, "$name: ReadKeyValue could not find key $kName in file";
return; return;
} }
if (eval { use Digest::MD5; 1 }) { if (eval "use Digest::MD5; 1") {
$key = Digest::MD5::md5_hex(unpack "H*", $key); $key = Digest::MD5::md5_hex(unpack "H*", $key);
$key .= Digest::MD5::md5_hex($key); $key .= Digest::MD5::md5_hex($key);
} }
@ -668,7 +672,7 @@ sub FlattenJSON {
my $buffer = shift; # buffer containing JSON data my $buffer = shift; # buffer containing JSON data
my $name = $hash->{NAME}; # Fhem device name my $name = $hash->{NAME}; # Fhem device name
eval { use JSON }; eval "use JSON";
return if($@); return if($@);
my $decoded = eval { decode_json($buffer) }; my $decoded = eval { decode_json($buffer) };