diff --git a/fhem/FHEM/98_HTTPMOD.pm b/fhem/FHEM/98_HTTPMOD.pm index 2b24fb504..e45819155 100755 --- a/fhem/FHEM/98_HTTPMOD.pm +++ b/fhem/FHEM/98_HTTPMOD.pm @@ -1,6 +1,6 @@ ######################################################################### # $Id$ -# fhem Modul für Geräte mit Web-Oberfläche / Webservices +# fhem Modul für Geräte mit Web-Oberfläche / Webservices # # This file is part of fhem. # @@ -32,7 +32,7 @@ # 2014-11-17 added queueing for requests, fixed timeout # 2014-11-30 fixed race condition, added ignoreRedirects # an neues HttpUtils angepasst -# 2014-12-05 definierte Attribute werden zu userattr der Instanz hinzugefügt +# 2014-12-05 definierte Attribute werden zu userattr der Instanz hinzugefügt # use $hash->{HTTPHEADER} or $hash->{httpheader} # 2014-12-22 Warnung in Set korrigiert # 2015-02-11 added attributes for a generic get feature, new get function, attributes "map" for readings, @@ -86,7 +86,7 @@ # instead of ignoring everything related # 2016-02-05 fixed a warning caused by missing initialisation of .setList internal # 2016-02-07 allowed more regular expression modifiers in RegOpt, added IMap / OMap / IExpr / OExpr -# 2016-02-13 enable sslVersion attribute für HttpUtils and httpVersion +# 2016-02-13 enable sslVersion attribute für HttpUtils and httpVersion # 2016-02-14 add sslArgs attribute - e.g. as attr myDevice sslArgs SSL_verify_mode,SSL_VERIFY_NONE # Log old attrs and offer set upgradeAttributes # 2016-02-15 added replacement type key and set storeKeyValue @@ -138,12 +138,15 @@ # catch warnings in evals - to be finished (drop subroutine and add inline) # 2017-03-16 Log line removed in JsonFlatter (creates warning if $value is not defined and it is not needed anyways) # 2017-03-23 new attribute removeBuf +# 2017-05-07 fixed typo in documentation +# 2017-05-08 optimized warning signal handling +# 2017-05-09 fixed character encoding of source file for documentation # # # Todo: # get after set um readings zu aktualisieren -# definierbarer prefix oder Suffix für Readingsnamen wenn sie von unterschiedlichen gets über readingXY erzeugt werden +# definierbarer prefix oder Suffix für Readingsnamen wenn sie von unterschiedlichen gets über readingXY erzeugt werden # # named groups im regexes [?. ) # you can refer to them by absolute number (using "$1" instead of "\g1" , etc) @@ -151,7 +154,7 @@ # -> if named groups exist - # reading mit Status je get (error, no match, ...) oder reading zum nachverfolgen der schritte, fehler, auth etc. # -# In _Attr bei Prüfungen auf get auch set berücksichtigen wo nötig, ebenso in der Attr Liste (oft fehlt set) +# In _Attr bei Prüfungen auf get auch set berücksichtigen wo nötig, ebenso in der Attr Liste (oft fehlt set) # featureAttrs aus hash verarbeiten # # Implement IMap und IExpr for get @@ -159,7 +162,7 @@ # replacement scope attribute? # make axtracting the sid after a get / update an attribute / option? # multi page log extraction? -# Profiling von Modbus übernehmen? +# Profiling von Modbus übernehmen? # extend httpmod to support simple tcp connections aver devio instead of HttpUtils? # extend devio for non blocking connect like httputils? # @@ -168,9 +171,9 @@ # verwendung von defptr: # $hash->{defptr}{readingBase}{$reading} gibt zu einem Reading-Namen den Ursprung an, z.B. get oder reading -# readingNum die zugehörige Nummer, z.B. 01 +# readingNum die zugehörige Nummer, z.B. 01 # readingSubNum ggf. eine Unternummer (bei reading01-001) -# wird von MaxAge verwendet um schnell zu einem Reading die zugehörige MaxAge Definition finden zu können +# wird von MaxAge verwendet um schnell zu einem Reading die zugehörige MaxAge Definition finden zu können # # $hash->{defptr}{requestReadings}{$reqType}{$baseReading} # wird von DeleteOnError und DeleteIfUnmatched verwendet. @@ -179,7 +182,7 @@ # aber ohne eventuelle Extension bei mehreren Matches. # Liefert "$context $num", also z.B. get 1 - dort wird nach DeleteOn.. gesucht # wichtig um z.B. von reqType "get01" baseReading "Temperatur" auf reading 02 zu kommen -# falls get01 keine eigenen parsing definitions enthält +# falls get01 keine eigenen parsing definitions enthält # DeleteOn... wird dann beim reading 02 etc. spezifiziert. # @@ -204,7 +207,7 @@ sub HTTPMOD_AddToQueue($$$$$;$$$$); sub HTTPMOD_JsonFlatter($$;$); sub HTTPMOD_ExtractReading($$$$$); -my $HTTPMOD_Version = '3.3.9 - 23.3.2017'; +my $HTTPMOD_Version = '3.3.11 - 8.5.2017'; # # FHEM module intitialisation @@ -289,9 +292,9 @@ sub HTTPMOD_Initialize($) "get[0-9]*PullToFile " . "get[0-9]*PullIterate " . - "set[0-9]+Min " . # todo: min, max und hint auch für get, Schreibweise der Liste auf (get|set) vereinheitlichen + "set[0-9]+Min " . # todo: min, max und hint auch für get, Schreibweise der Liste auf (get|set) vereinheitlichen "set[0-9]+Max " . - "set[0-9]+Hint " . # Direkte Fhem-spezifische Syntax für's GUI, z.B. "6,10,14" bzw. slider etc. + "set[0-9]+Hint " . # Direkte Fhem-spezifische Syntax für's GUI, z.B. "6,10,14" bzw. slider etc. "set[0-9]*NoArg:0,1 " . # don't expect a value - for set on / off and similar. (default for get) "[gs]et[0-9]*TextArg:0,1 " . # just pass on a raw text value without validation / further conversion "set[0-9]*ParseResponse:0,1 " . # parse response to set as if it was a get @@ -326,7 +329,7 @@ sub HTTPMOD_Initialize($) "replacement[0-9]+Regex " . "replacement[0-9]+Mode:reading,internal,text,expression,key " . # defaults to text "replacement[0-9]+Value " . # device:reading, device:internal, text, replacement expression - "[gs]et[0-9]*Replacement[0-9]+Value " . # can overwrite a global replacement value - todo: auch für auth? + "[gs]et[0-9]*Replacement[0-9]+Value " . # can overwrite a global replacement value - todo: auch für auth? "do_not_notify:1,0 " . "disable:0,1 " . @@ -470,9 +473,10 @@ sub HTTPMOD_Attr(@) if ($cmd eq "set") { if ($aName =~ /Regex/) { # catch all Regex like attributes + my $oldSig = ($SIG{__WARN__} ? $SIG{__WARN__} : 'DEFAULT'); $SIG{__WARN__} = sub { Log3 $name, 3, "$name: set attr $aName $aVal created warning: @_"; }; eval {qr/$aVal/}; - $SIG{__WARN__} = 'DEFAULT'; + $SIG{__WARN__} = $oldSig; if ($@) { Log3 $name, 3, "$name: Attr with invalid regex in attr $name $aName $aVal: $@"; return "Invalid Regex $aVal"; @@ -500,9 +504,10 @@ sub HTTPMOD_Attr(@) my $timeDiff = 0; my @matchlist = (); no warnings qw(uninitialized); + my $oldSig = ($SIG{__WARN__} ? $SIG{__WARN__} : 'DEFAULT'); $SIG{__WARN__} = sub { Log3 $name, 3, "$name: set attr $aName $aVal created warning: @_"; }; eval $aVal; - $SIG{__WARN__} = 'DEFAULT'; + $SIG{__WARN__} = $oldSig; if ($@) { Log3 $name, 3, "$name: Attr with invalid Expression in attr $name $aName $aVal: $@"; return "Invalid Expression $aVal"; @@ -536,9 +541,10 @@ sub HTTPMOD_Attr(@) Log3 $name, 5, "$name: validating attr $name $aName $aVal"; if (AttrVal($name, "replacement${2}Mode", "text") eq "expression") { no warnings qw(uninitialized); + my $oldSig = ($SIG{__WARN__} ? $SIG{__WARN__} : 'DEFAULT'); $SIG{__WARN__} = sub { Log3 $name, 3, "$name: set attr $aName $aVal created warning: @_"; }; eval $aVal; - $SIG{__WARN__} = 'DEFAULT'; + $SIG{__WARN__} = $oldSig; if ($@) { Log3 $name, 3, "$name: Attr with invalid Expression (mode is expression) in attr $name $aName $aVal: $@"; return "Attr with invalid Expression (mode is expression) in attr $name $aName $aVal: $@"; @@ -628,7 +634,7 @@ sub HTTPMOD_Attr(@) my $vgl = $1; # attribute name in list - probably a regex my $opt = $2; # attribute hint in list if ($aName =~ $vgl) { # yes - the name in the list now matches as regex - # $aName ist eine Ausprägung eines wildcard attrs + # $aName ist eine Ausprägung eines wildcard attrs addToDevAttrList($name, "$aName" . $opt); # create userattr with hint to allow changing by click in fhemweb if ($opt) { # remove old entries without hint @@ -939,11 +945,11 @@ sub HTTPMOD_ReadKeyValue($$) } return $dec; - } - else { + } else { Log3 $name, 4, "$name: ReadKeyValue could not find key $kName in file"; return undef; } + return; } @@ -976,10 +982,10 @@ sub HTTPMOD_Replace($$$) # value can be specific for a get / set / auth step my $value = ""; if ($context && defined ($attr{$name}{"${type}Replacement${rNum}Value"})) { - # get / set / auth mit individuellem Replacement für z.B. get01 + # get / set / auth mit individuellem Replacement für z.B. get01 $value = $attr{$name}{"${type}Replacement${rNum}Value"}; } elsif ($context && defined ($attr{$name}{"${context}Replacement${rNum}Value"})) { - # get / set / auth mit generischem Replacement für alle gets / sets + # get / set / auth mit generischem Replacement für alle gets / sets $value = $attr{$name}{"${context}Replacement${rNum}Value"}; } elsif (defined ($attr{$name}{"replacement${rNum}Value"})) { # ganz generisches Replacement @@ -1016,9 +1022,10 @@ sub HTTPMOD_Replace($$$) $match = 1; } } elsif ($mode eq 'expression') { + my $oldSig = ($SIG{__WARN__} ? $SIG{__WARN__} : 'DEFAULT'); $SIG{__WARN__} = sub { Log3 $name, 3, "$name: Replacement $rNum with expression $value created warning: @_"; }; $match = eval {$string =~ s/$regex/$value/gee}; - $SIG{__WARN__} = 'DEFAULT'; + $SIG{__WARN__} = $oldSig; if ($@) { Log3 $name, 3, "$name: Replace: invalid regex / expression: /$regex/$value/gee - $@"; } @@ -1043,10 +1050,11 @@ sub HTTPMOD_ModifyWithExpr($$$$$) my ($name, $context, $num, $attr, $text) = @_; my $exp = AttrVal($name, "${context}${num}${attr}", undef); if ($exp) { - my $old = $text; + my $old = $text; + my $oldSig = ($SIG{__WARN__} ? $SIG{__WARN__} : 'DEFAULT'); $SIG{__WARN__} = sub { Log3 $name, 3, "$name: ModifyWithExpr ${context}${num}${attr} created warning: @_"; }; $text = eval($exp); - $SIG{__WARN__} = 'DEFAULT'; + $SIG{__WARN__} = $oldSig; if ($@) { Log3 $name, 3, "$name: error in $attr for $context $num: $@"; } @@ -1129,7 +1137,7 @@ sub HTTPMOD_Auth($@) } $hash->{LastAuthTry} = FmtDateTime(gettimeofday()); HTTPMOD_HandleSendQueue("direct:".$name); # AddToQueue with prio did not call this. - return undef; + return; } @@ -1168,11 +1176,11 @@ sub HTTPMOD_UpdateHintList($) } elsif (AttrVal($name, "${context}${num}NoArg", undef)) { # NoArg explicitely specified for a set? $opt = $oName . ":noArg"; } else { - $opt = $oName; # nur den Namen für opt verwenden. + $opt = $oName; # nur den Namen für opt verwenden. } } elsif ($context eq "get") { if (AttrVal($name, "${context}${num}TextArg", undef)) { # TextArg explicitely specified for a get? - $opt = $oName; # nur den Namen für opt verwenden. + $opt = $oName; # nur den Namen für opt verwenden. } else { $opt = $oName . ":noArg"; # sonst noArg bei get } @@ -1185,6 +1193,7 @@ sub HTTPMOD_UpdateHintList($) delete $hash->{".updateHintList"}; Log3 $name, 5, "$name: UpdateHintList: setlist = " . $hash->{".setList"}; Log3 $name, 5, "$name: UpdateHintList: getlist = " . $hash->{".getList"}; + return; } @@ -1268,6 +1277,7 @@ sub HTTPMOD_UpdateRequestHash($) } } delete $hash->{".updateRequestHash"}; + return; } @@ -1354,7 +1364,7 @@ sub HTTPMOD_Set($@) } # Vorbereitung: - # suche den übergebenen setName in den Attributen und setze setNum + # suche den übergebenen setName in den Attributen und setze setNum foreach my $aName (keys %{$attr{$name}}) { if ($aName =~ /^set([0-9]+)Name$/) { # ist das Attribut ein "setXName" ? @@ -1364,15 +1374,15 @@ sub HTTPMOD_Set($@) } } - # gültiger set Aufruf? ($setNum oben schon gesetzt?) + # gültiger set Aufruf? ($setNum oben schon gesetzt?) if(!defined ($setNum)) { HTTPMOD_UpdateHintList($hash) if ($hash->{".updateHintList"}); return "Unknown argument $setName, choose one of " . $hash->{".setList"}; } Log3 $name, 5, "$name: set found option $setName in attribute set${setNum}Name"; - if (!AttrVal($name, "set${setNum}NoArg", undef)) { # soll überhaupt ein Wert übergeben werden? - if (!defined($setVal)) { # Ist ein Wert übergeben? + if (!AttrVal($name, "set${setNum}NoArg", undef)) { # soll überhaupt ein Wert übergeben werden? + if (!defined($setVal)) { # Ist ein Wert übergeben? Log3 $name, 3, "$name: set without value given for $setName"; return "no value given to set $setName"; } @@ -1391,8 +1401,8 @@ sub HTTPMOD_Set($@) %rmap = split (/, *|:/, $rm); # reverse hash aus dem reverse string - if (defined($rmap{$setVal})) { # Eintrag für den übergebenen Wert in der Map? - $rawVal = $rmap{$setVal}; # entsprechender Raw-Wert für das Gerät + if (defined($rmap{$setVal})) { # Eintrag für den übergebenen Wert in der Map? + $rawVal = $rmap{$setVal}; # entsprechender Raw-Wert für das Gerät Log3 $name, 5, "$name: set found $setVal in rmap and converted to $rawVal"; } else { Log3 $name, 3, "$name: set value $setVal did not match defined map"; @@ -1411,14 +1421,14 @@ sub HTTPMOD_Set($@) # kein TextArg? if (!AttrVal($name, "set${setNum}TextArg", undef)) { - # prüfe Min + # prüfe Min if (AttrVal($name, "set${setNum}Min", undef)) { my $min = AttrVal($name, "set${setNum}Min", undef); Log3 $name, 5, "$name: is checking value $rawVal against min $min"; return "set value $rawVal is smaller than Min ($min)" if ($rawVal < $min); } - # Prüfe Max + # Prüfe Max if (AttrVal($name, "set${setNum}Max", undef)) { my $max = AttrVal($name, "set${setNum}Max", undef); Log3 $name, 5, "$name: set is checking value $rawVal against max $max"; @@ -1432,9 +1442,10 @@ sub HTTPMOD_Set($@) $exp = AttrVal($name, "set${setNum}IExpr", ""); # new syntax overrides old one if ($exp) { my $val = $rawVal; + my $oldSig = ($SIG{__WARN__} ? $SIG{__WARN__} : 'DEFAULT'); $SIG{__WARN__} = sub { Log3 $name, 3, "$name: Set IExpr $exp created warning: @_"; }; $rawVal = eval($exp); - $SIG{__WARN__} = 'DEFAULT'; + $SIG{__WARN__} = $oldSig; if ($@) { Log3 $name, 3, "$name: Set error in setExpr $exp: $@"; } else { @@ -1480,7 +1491,7 @@ sub HTTPMOD_Get($@) Log3 $name, 5, "$name: get called with $getName " if ($getName ne "?"); # Vorbereitung: - # suche den übergebenen getName in den Attributen, setze getNum falls gefunden + # suche den übergebenen getName in den Attributen, setze getNum falls gefunden foreach my $aName (keys %{$attr{$name}}) { if ($aName =~ /^get([0-9]+)Name$/) { # ist das Attribut ein "getXName" ? if ($getName eq $attr{$name}{$aName}) { # ist es der im konkreten get verwendete getName? @@ -1489,7 +1500,7 @@ sub HTTPMOD_Get($@) } } - # gültiger get Aufruf? ($getNum oben schon gesetzt?) + # gültiger get Aufruf? ($getNum oben schon gesetzt?) if(!defined ($getNum)) { HTTPMOD_UpdateHintList($hash) if ($hash->{".updateHintList"}); return "Unknown argument $getName, choose one of " . $hash->{".getList"}; @@ -1681,10 +1692,11 @@ sub HTTPMOD_FormatReading($$$$$) my $timeStr = ReadingsTimestamp($name, $reading, 0); $timeDiff = ($now - time_str2num($timeStr)) if ($timeStr); - + + my $oldSig = ($SIG{__WARN__} ? $SIG{__WARN__} : 'DEFAULT'); $SIG{__WARN__} = sub { Log3 $name, 3, "$name: FormatReadig OExpr $expr created warning: @_"; }; $val = eval $expr; - $SIG{__WARN__} = 'DEFAULT'; + $SIG{__WARN__} = $oldSig; if ($@) { Log3 $name, 3, "$name: FormatReading error, context $context, expression $expr: $@"; } @@ -1694,8 +1706,8 @@ sub HTTPMOD_FormatReading($$$$$) if ($map) { # gibt es eine Map? my %map = split (/, +|:/, $map); # hash aus dem map string - if (defined($map{$val})) { # Eintrag für den gelesenen Wert in der Map? - my $nVal = $map{$val}; # entsprechender sprechender Wert für den rohen Wert aus dem Gerät + if (defined($map{$val})) { # Eintrag für den gelesenen Wert in der Map? + my $nVal = $map{$val}; # entsprechender sprechender Wert für den rohen Wert aus dem Gerät Log3 $name, 5, "$name: FormatReading found $val in map and converted to $nVal"; $val = $nVal; } else { @@ -1827,9 +1839,10 @@ sub HTTPMOD_ExtractReading($$$$$) if ($recomb) { Log3 $name, 5, "$name: ExtractReading is recombining $match matches with expression $recomb"; + my $oldSig = ($SIG{__WARN__} ? $SIG{__WARN__} : 'DEFAULT'); $SIG{__WARN__} = sub { Log3 $name, 3, "$name: RecombineExpr $recomb created warning: @_"; }; my $val = (eval $recomb); - $SIG{__WARN__} = 'DEFAULT'; + $SIG{__WARN__} = $oldSig; if ($@) { Log3 $name, 3, "$name: ExtractReading error in RecombineExpr: $@"; } @@ -1899,9 +1912,10 @@ sub HTTPMOD_PullToFile($$$$) while ($buffer =~ /$regex/g) { $matches++; no warnings qw(uninitialized); + my $oldSig = ($SIG{__WARN__} ? $SIG{__WARN__} : 'DEFAULT'); $SIG{__WARN__} = sub { Log3 $name, 3, "$name: RecombineExpr $recombine created warning: @_"; }; my $val = eval($recombine); - $SIG{__WARN__} = 'DEFAULT'; + $SIG{__WARN__} = $oldSig; if ($@) { Log3 $name, 3, "$name: PullToFile error in RecombineExpr $recombine: $@"; } else { @@ -1996,9 +2010,10 @@ sub HTTPMOD_DoMaxAge($) if ($mode eq "expression") { Log3 $name, 4, "$name: MaxAge: reading $reading too old - using Perl expression as MaxAge replacement: $rep"; my $val = ReadingsVal($name, $reading, ""); + my $oldSig = ($SIG{__WARN__} ? $SIG{__WARN__} : 'DEFAULT'); $SIG{__WARN__} = sub { Log3 $name, 3, "$name: MaxAge replacement expr $rep created warning: @_"; }; $rep = eval($rep); - $SIG{__WARN__} = 'DEFAULT'; + $SIG{__WARN__} = $oldSig; if($@) { Log3 $name, 3, "$name: MaxAge: error in replacement expression $1: $@"; $rep = "error in replacement expression"; @@ -2682,7 +2697,7 @@ HTTPMOD_AddToQueue($$$$$;$$$$){ =pod =item device =item summary retrieves readings from devices with an HTTP Interface -=item summary_DE fragt Readings von Geräten mit HTTP-Interface ab +=item summary_DE fragt Readings von Geräten mit HTTP-Interface ab =begin html @@ -3504,7 +3519,7 @@ HTTPMOD_AddToQueue($$$$$;$$$$){ that contains the error message of the last error returned from HttpUtils.
  • removeBuf
    • if set to 1 then HTTPMOD removes the internal named buf when a HTTP-response has been - received. $hash->{buf} is used internally be Fhem httpUtils and in some use cases it is desireable to remove this internal after reception because it contains a vers long response which looks ugly in Fhemweb. + received. $hash->{buf} is used internally be Fhem httpUtils and in some use cases it is desireable to remove this internal after reception because it contains a very long response which looks ugly in Fhemweb.
  • timeout
    • time in seconds to wait for an answer. Default value is 2