diff --git a/fhem/FHEM/98_HTTPMOD.pm b/fhem/FHEM/98_HTTPMOD.pm index e8d5af116..6739afd4e 100755 --- a/fhem/FHEM/98_HTTPMOD.pm +++ b/fhem/FHEM/98_HTTPMOD.pm @@ -29,8 +29,12 @@ # 2014-3-13 added noShutdown and disable attributes # 2014-4-8 fixed noShutdown check # 2014-4-9 added Attribute timeout as suggested by Frank -# 2014-11-18 fixed timeout attribute and redirects -# +# 2014-10-22 added generic set function, alternative naming of old attributes, ... +# 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 +# use $hash->{HTTPHEADER} or $hash->{httpheader} package main; @@ -47,17 +51,7 @@ sub HTTPMOD_Get($@); sub HTTPMOD_Attr(@); sub HTTPMOD_GetUpdate($); sub HTTPMOD_Read($$$); - -# -# lists of Set and Get Options for this module -# so far this is not used - -my %HTTPMOD_sets = ( -); - -my %HTTPMOD_gets = ( -); - +sub HTTPMOD_AddToQueue($$$$$;$$$); # # FHEM module intitialisation @@ -69,19 +63,47 @@ sub HTTPMOD_Initialize($) $hash->{DefFn} = "HTTPMOD_Define"; $hash->{UndefFn} = "HTTPMOD_Undef"; - #$hash->{SetFn} = "HTTPMOD_Set"; + $hash->{SetFn} = "HTTPMOD_Set"; #$hash->{GetFn} = "HTTPMOD_Get"; $hash->{AttrFn} = "HTTPMOD_Attr"; $hash->{AttrList} = - "do_not_notify:1,0 " . - "readingsName.* " . + "reading[0-9]*Name " . # new syntax for readings + "reading[0-9]*Regex " . + "reading[0-9]*Expr " . + + "readingsName.* " . # old syntax "readingsRegex.* " . "readingsExpr.* " . - "requestHeader.* " . + + "requestHeader.* " . "requestData.* " . - "disable:0,1 " . + "reAuthRegex " . "noShutdown:0,1 " . + "timeout " . + "queueDelay " . + "queueMax " . + "minSendDelay " . + + "sid[0-9]*URL " . + "sid[0-9]*IDRegex " . + "sid[0-9]*Data.* " . + "sid[0-9]*Header.* " . + "sid[0-9]*IgnoreRedirects " . + + "set[0-9]+Name " . + "set[0-9]*URL " . + "set[0-9]*Data.* " . + "set[0-9]*Header.* " . + "set[0-9]+Min " . + "set[0-9]+Max " . + "set[0-9]+Map " . # Umwandlung von Codes für das Gerät zu sprechenden Namen, z.B. "0:mittig, 1:oberhalb, 2:unterhalb" + "set[0-9]+Hint " . # Direkte Fhem-spezifische Syntax für's GUI, z.B. "6,10,14" bzw. slider etc. + "set[0-9]+Expr " . + "set[0-9]*ReAuthRegex " . + + "do_not_notify:1,0 " . + "disable:0,1 " . $readingFnAttributes; } @@ -109,17 +131,11 @@ sub HTTPMOD_Define($$) } } - $hash->{url} = $url; + $hash->{MainURL} = $url; $hash->{Interval} = $inter; - - # for non blocking HTTP Get - $hash->{callback} = \&HTTPMOD_Read; - $hash->{timeout} = AttrVal($name, "timeout", 2); - #$hash->{timeout} = 2; - - # initial request after 2 secs, there timer is set to interval for further update - InternalTimer(gettimeofday()+2, "HTTPMOD_GetUpdate", $hash, 0); - + + # initial request after 2 secs, there the timer is set to interval for further updates + InternalTimer(gettimeofday()+2, "HTTPMOD_GetUpdate", "update:$name", 0); return undef; } @@ -129,7 +145,10 @@ sub HTTPMOD_Define($$) sub HTTPMOD_Undef($$) { my ( $hash, $arg ) = @_; - RemoveInternalTimer($hash); + my $name = $hash->{NAME}; + RemoveInternalTimer ("timeout:$name"); + RemoveInternalTimer ("queue:$name"); + RemoveInternalTimer ("update:$name"); return undef; } @@ -145,42 +164,113 @@ HTTPMOD_Attr(@) # $name is device name # aName and aVal are Attribute name and value - # Attributes are readingsRegexp.*, requestHeader.* and requestData.* - - # requestHeader and requestData need no special treatment here - # however they have to be added to $hash later so HttpUtils - # an pick them up. Maybe later versions of HttpUtils could - # also pick up attributes? - - # readingsRegex.* needs validation though. - # ... to be implemented later here ... - # each readingsRegexX defines a pair of Reading and Regex + # simple attributes like requestHeader and requestData need no special treatment here + # readingsExpr, readingsRegex.* or reAuthRegex need validation though. - if ($cmd eq "set") { - if ($aName =~ "readingsRegex") { + if ($cmd eq "set") { + if ($aName =~ "Regex") { # catch all Regex like attributes eval { qr/$aVal/ }; if ($@) { - Log3 $name, 3, "HTTPOD: Invalid regex in attr $name $aName $aVal: $@"; + Log3 $name, 3, "$name: Invalid regex in attr $name $aName $aVal: $@"; return "Invalid Regex $aVal"; } - } elsif ($aName =~ "readingsExpr") { + } elsif ($aName =~ "Expr") { # validate all Expressions my $val = 1; eval $aVal; if ($@) { - Log3 $name, 3, "HTTPOD: Invalid Expression in attr $name $aName $aVal: $@"; + Log3 $name, 3, "$name: Invalid Expression in attr $name $aName $aVal: $@"; return "Invalid Expression $aVal"; } } + addToDevAttrList($name, $aName); } - return undef; } +# create a new authenticated session +######################################################################### +sub HTTPMOD_Auth($@) +{ + my ( $hash, @a ) = @_; + my $name = $hash->{NAME}; + + # get all steps + my %steps; + foreach my $attr (keys %{$attr{$name}}) { + if ($attr =~ "sid([0-9]+).+") { + $steps{$1} = 1; + } + } + Log3 $name, 4, "$name: start Auth with Steps: " . join (" ", sort keys %steps); + + $hash->{sid} = ""; + foreach my $step (sort keys %steps) { + + my ($url, $header, $data, $type, $retrycount, $ignoreredirects); + # hole alle Header bzw. generischen Header ohne Nummer + $header = join ("\r\n", map ($attr{$name}{$_}, sort grep (/sid${step}Header/, keys %{$attr{$name}}))); + if (length $header == 0) { + $header = join ("\r\n", map ($attr{$name}{$_}, sort grep (/sidHeader/, keys %{$attr{$name}}))); + } + # hole Bestandteile der Post Data + $data = join ("\r\n", map ($attr{$name}{$_}, sort grep (/sid${step}Data/, keys %{$attr{$name}}))); + if (length $data == 0) { + $data = join ("\r\n", map ($attr{$name}{$_}, sort grep (/sidData/, keys %{$attr{$name}}))); + } + # hole URL + $url = AttrVal($name, "sid${step}URL", undef); + if (!$url) { + $url = AttrVal($name, "sidURL", undef); + } + $ignoreredirects = AttrVal($name, "sid${step}IgnoreRedirects", undef); + $retrycount = 0; + $type = "Auth$step"; + HTTPMOD_AddToQueue($hash, $url, $header, $data, $type, $retrycount, $ignoreredirects); + } + return undef; +} + + +# put URL, Header, Data etc. in hash for HTTPUtils Get +# for set with index $setNum +######################################################################### +sub HTTPMOD_DoSet($$$) +{ + my ($hash, $setNum, $rawVal) = @_; + my $name = $hash->{NAME}; + my ($url, $header, $data, $type, $count); + + # hole alle Header bzw. generischen Header ohne Nummer + $header = join ("\r\n", map ($attr{$name}{$_}, sort grep (/set${setNum}Header/, keys %{$attr{$name}}))); + if (length $header == 0) { + $header = join ("\r\n", map ($attr{$name}{$_}, sort grep (/setHeader/, keys %{$attr{$name}}))); + } + # hole Bestandteile der Post data + $data = join ("\r\n", map ($attr{$name}{$_}, sort grep (/set${setNum}Data/, keys %{$attr{$name}}))); + if (length $data == 0) { + $data = join ("\r\n", map ($attr{$name}{$_}, sort grep (/setData/, keys %{$attr{$name}}))); + } + # hole URL + $url = AttrVal($name, "set${setNum}URL", undef); + if (!$url) { + $url = AttrVal($name, "setURL", undef); + } + + # ersetze $val in header, data und URL + $header =~ s/\$val/$rawVal/g; + $data =~ s/\$val/$rawVal/g; + $url =~ s/\$val/$rawVal/g; + + $type = "Set$setNum"; + + HTTPMOD_AddToQueue($hash, $url, $header, $data, $type); # leave RetryCount, IgnoreRedirects and Prio + return undef; +} + # # SET command -# currently not used ######################################################################### sub HTTPMOD_Set($@) { @@ -188,36 +278,109 @@ sub HTTPMOD_Set($@) return "\"set HTTPMOD\" needs at least an argument" if ( @a < 2 ); # @a is an array with DeviceName, SetName, Rest of Set Line - my $name = shift @a; - my $attr = shift @a; - my $arg = join("", @a); + my ($name, $setName, $setVal) = @a; + my (%rmap, $setNum, $setOpt, $setList, $rawVal); - if(!defined($HTTPMOD_sets{$attr})) { - my @cList = keys %HTTPMOD_sets; - return "Unknown argument $attr, choose one of " . join(" ", @cList); + Log3 $name, 5, "$name: set called with $setName " . ($setVal ? $setVal : ""); + + # verarbeite Attribute "set[0-9]*Name set[0-9]*URL set[0-9]*Data.* set[0-9]*Header.* + # set[0-9]*Min set[0-9]*Max set[0-9]*Map set[0-9]*Expr set[0-9]*Hint + + # Vorbereitung: + # suche den übergebenen setName in den Attributen, setze setNum und erzeuge rmap falls gefunden + foreach my $aName (keys %{$attr{$name}}) { + if ($aName =~ "set([0-9]+)Name") { # ist das Attribut ein "setXName" ? + my $setI = $1; # merke die Nummer im Namen + my $iName = $attr{$name}{$aName}; # Name der Set-Option diser Schleifen-Iteration + + if ($setName eq $iName) { # ist es der im konkreten Set verwendete setName? + $setNum = $setI; # gefunden -> merke Nummer X im Attribut + } + + # erzeuge setOpt für die Rückgabe bei set X ? + if (AttrVal($name, "set${setI}Map", undef)) { # nochmal: gibt es eine Map (für Hint) + my $hint = AttrVal($name, "set${setI}Map", undef); # create hint from map + $hint =~ s/([^ ,\$]+):([^ ,\$]+,?) ?/$2/g; + $setOpt = $iName . ":$hint"; # setOpt ist Name:Hint (aus Map) + } else { + $setOpt = $iName; # nur den Namen für setopt verwenden. + } + if (AttrVal($name, "set${setI}Hint", undef)) { # gibt es einen expliziten Hint? + $setOpt = $iName . ":" . + AttrVal($name, "set${setI}Hint", undef); + } + $setList .= $setOpt . " "; # speichere Liste mit allen Sets inkl. der Hints nach ":" für Rückgabe bei Set ? + } + } + + # gültiger set Aufruf? ($setNum oben schon gesetzt?) + if(!defined ($setNum)) { + return "Unknown argument $setName, choose one of $setList"; } - return undef; + # Ist überhaupt ein Wert übergeben? + if (!defined($setVal)) { + Log3 $name, 3, "$name: no value given to set $setName"; + return "no value given to set $setName"; + } + Log3 $name, 5, "$name: Set found option $setName in attribute set${setNum}Name"; + + # Eingabevalidierung von Sets mit Definition per Attributen + # 1. Schritt, falls definiert, per Umkehrung der Map umwandeln (z.B. Text in numerische Codes) + if (AttrVal($name, "set${setNum}Map", undef)) { # gibt es eine Map? + my $rm = AttrVal($name, "set${setNum}Map", undef); + $rm =~ s/([^ ,\$]+):([^ ,\$]+),? ?/$2 $1 /g; # reverse map string erzeugen + %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 + Log3 $name, 5, "$name: found $setVal in rmap and converted to $rawVal"; + } else { + Log3 $name, 3, "$name: Set value $setVal did not match defined map"; + return "set value $setVal did not match defined map"; + } + } else { + # wenn keine map, dann wenigstens sicherstellen, dass Wert numerisch. + if ($setVal !~ /^-?\d+\.?\d*$/) { + Log3 $name, 3, "$name: set value $setVal is not numeric"; + return "set value $setVal is not numeric"; + } + $rawVal = $setVal; + } + + # 2. Schritt: falls definiert Min- und Max-Werte prüfen + if (AttrVal($name, "set${setNum}Min", undef)) { + my $min = AttrVal($name, "set${setNum}Min", undef); + Log3 $name, 5, "$name: checking value $rawVal against min $min"; + return "set value $rawVal is smaller than Min ($min)" + if ($rawVal < $min); + } + if (AttrVal($name, "set${setNum}Max", undef)) { + my $max = AttrVal($name, "set${setNum}Max", undef); + Log3 $name, 5, "$name: checking value $rawVal against max $max"; + return "set value $rawVal is bigger than Max ($max)" + if ($rawVal > $max); + } + + # 3. Schritt: Konvertiere mit setexpr falls definiert + if (AttrVal($name, "set${setNum}Expr", undef)) { + my $val = $rawVal; + my $exp = AttrVal($name, "set${setNum}Expr", undef); + $rawVal = eval($exp); + Log3 $name, 5, "$name: converted value $val to $rawVal using expr $exp"; + } + + Log3 $name, 4, "$name: set will now set $setName -> $rawVal"; + my $result = HTTPMOD_DoSet($hash, $setNum, $rawVal); + return "$setName -> $rawVal"; } + # # GET command # currently not used ######################################################################### sub HTTPMOD_Get($@) { - my ( $hash, @a ) = @_; - return "\"get HTTPMOD\" needs at least an argument" if ( @a < 2 ); - - # @a is an array with DeviceName and GetName - my $name = shift @a; - my $attr = shift @a; - - if(!defined($HTTPMOD_gets{$attr})) { - my @cList = keys %HTTPMOD_gets; - return "Unknown argument $attr, choose one of " . join(" ", @cList); - } - return undef; } @@ -228,43 +391,30 @@ sub HTTPMOD_Get($@) ################################### sub HTTPMOD_GetUpdate($) { - my ($hash) = @_; - my $name = $hash->{NAME}; + my (undef,$name) = split(':', $_[0]); + my $hash = $defs{$name}; + my ($url, $header, $data, $type, $count); - InternalTimer(gettimeofday()+$hash->{Interval}, "HTTPMOD_GetUpdate", $hash, 1); + RemoveInternalTimer ("update:$name"); + InternalTimer(gettimeofday()+$hash->{Interval}, "HTTPMOD_GetUpdate", "update:$name", 0); return if(AttrVal($name, "disable", undef)); - Log3 $name, 4, "HTTPMOD: GetUpdate called, hash = $hash, name = $name"; + Log3 $name, 4, "$name: GetUpdate called"; - if ( $hash->{url} eq "none" ) { + if ( $hash->{MainURL} eq "none" ) { return 0; } - my $header = join ("\r\n", map ($attr{$name}{$_}, sort grep (/requestHeader/, keys %{$attr{$name}}))); - if (length $header > 0) { - $hash->{header} = $header; - } else { - delete $hash->{header}; - } - - my $data = join ("\r\n", map ($attr{$name}{$_}, sort grep (/requestData/, keys %{$attr{$name}}))); - if (length $data > 0) { - $hash->{data} = $data; - } else { - delete $hash->{data}; - } - - if (AttrVal($name, "noShutdown", undef)) { - $hash->{noshutdown} = 1; - } else { - delete $hash->{noshutdown}; - }; - $hash->{timeout} = AttrVal($name, "timeout", 2); - $hash->{redirects} = 0; - HttpUtils_NonblockingGet($hash); + $url = $hash->{MainURL}; + $header = join ("\r\n", map ($attr{$name}{$_}, sort grep (/requestHeader/, keys %{$attr{$name}}))); + $data = join ("\r\n", map ($attr{$name}{$_}, sort grep (/requestData/, keys %{$attr{$name}}))); + $type = "Update"; + + HTTPMOD_AddToQueue($hash, $url, $header, $data, $type); # leave RetryCount, IgnoreRedirects and Prio } + # # read / parse new data from device # - callback for non blocking HTTP @@ -272,59 +422,254 @@ sub HTTPMOD_GetUpdate($) sub HTTPMOD_Read($$$) { my ($hash, $err, $buffer) = @_; - my $name = $hash->{NAME}; + my $name = $hash->{NAME}; + my $request = $hash->{REQUEST}; + my $type = $request->{type}; + $hash->{BUSY} = 0; + RemoveInternalTimer ($hash); # Remove remaining timeouts of HttpUtils (should be done in HttpUtils) + + $hash->{HTTPHEADER} = "" if (!$hash->{HTTPHEADER}); + $hash->{httpheader} = "" if (!$hash->{httpheader}); + my $header = $hash->{HTTPHEADER} . $hash->{httpheader}; if ($err) { - Log3 $name, 3, "HTTPMOD got error in callback: $err"; + Log3 $name, 3, "$name: read callback: request type was $type" . + ($header ? ",\r\nheader: $header" : ", no headers") . + ($buffer ? ",\r\nbuffer: $buffer" : ", buffer empty") . + ($err ? ", \r\nError $err" : ""); return; } - Log3 $name, 5, "HTTPMOD: Callback called: Hash: $hash, Name: $name, buffer: $buffer\r\n"; - - my $msg = ""; - readingsBeginUpdate($hash); - foreach my $a (sort (grep (/readingsName/, keys %{$attr{$name}}))) { - $a =~ /readingsName(.*)/; - if (defined ($attr{$name}{'readingsName' . $1}) && - defined ($attr{$name}{'readingsRegex' . $1})) { - my $reading = $attr{$name}{'readingsName' . $1}; - my $regex = $attr{$name}{'readingsRegex' . $1}; - my $expr = ""; - if (defined ($attr{$name}{'readingsExpr' . $1})) { - $expr = $attr{$name}{'readingsExpr' . $1}; + + Log3 $name, 5, "$name: Read Callback: Request type was $type" . + ($header ? ",\r\nheader: $header" : ", no headers") . + ($buffer ? ",\r\nbuffer: $buffer" : ", buffer empty"); + + + $buffer = $header . "\r\n\r\n" . $buffer if ($header); + + if ($type =~ "Auth(.*)") { + my $step = $1; + # sid extrahieren + if (AttrVal($name, "sid${step}IDRegex", undef)) { + if ($buffer =~ AttrVal($name, "sid1IDRegex", undef)) { + $hash->{sid} = $1; + Log3 $name, 5, "$name: set sid to $hash->{sid}"; + } else { + Log3 $name, 5, "$name: buffer did not match IDRegex " . + AttrVal($name, "sid${step}IDRegex", undef); } - Log3 $name, 5, "HTTPMOD: Trying to extract Reading $reading with regex /$regex/..."; + } + } elsif ($type =~ "Set(.*)") { + my $setNum = $1; + my $ReAuthRegex = AttrVal($name, "set${setNum}ReAuthRegex", AttrVal($name, "setReAuthRegex", undef)); + if ($ReAuthRegex) { + Log3 $name, 5, "$name: checking response with ReAuthRegex $ReAuthRegex"; + if ($buffer =~ $ReAuthRegex) { + Log3 $name, 4, "$name: New authentication required"; + if ($request->{retryCount} < 1) { + HTTPMOD_Auth $hash; + $request->{retryCount}++; + Log3 $name, 4, "$name: ReQueuing set with new retryCount $request->{retryCount} ..."; + HTTPMOD_AddToQueue ($hash, $request->{url}, $request->{header}, + $request->{data}, $request->{type}, $request->{retryCount}); + return undef; + } else { + Log3 $name, 4, "$name: no more retries left - did authentication not work?"; + } + } + } + } elsif ($type eq "Update") { + my $ReAuthRegex = AttrVal($name, "reAuthRegex", undef); + if ($ReAuthRegex) { + Log3 $name, 5, "$name: checking response with ReAuthRegex $ReAuthRegex"; + if ($buffer =~ $ReAuthRegex) { + Log3 $name, 4, "$name: New authentication required"; + if ($request->{retryCount} < 1) { + HTTPMOD_Auth $hash; + $request->{retryCount}++; + Log3 $name, 4, "$name: ReQueueing GetUpdate with new retryCount $request->{retryCount} ..."; + HTTPMOD_AddToQueue ($hash, $request->{url}, $request->{header}, + $request->{data}, $request->{type}, $request->{retryCount}); + return undef; + } else { + Log3 $name, 4, "$name: no more retries left - did authentication not work?"; + } + } + } + + Log3 $name, 5, "$name: start extracting Readings from Response to GetUpdate"; + my $unmatched = ""; + readingsBeginUpdate($hash); + foreach my $a (sort (grep (/readings?[0-9]*Name/, keys %{$attr{$name}}))) { + $a =~ /readings?([0-9]*)Name(.*)/; + my ($reading, $regex, $expr); + if (($a =~ /readingsName(.*)/) && defined ($attr{$name}{'readingsName' . $1}) + && defined ($attr{$name}{'readingsRegex' . $1})) { + # old syntax + $reading = $attr{$name}{'readingsName' . $1}; + $regex = $attr{$name}{'readingsRegex' . $1}; + $expr = ""; + if (defined ($attr{$name}{'readingsExpr' . $1})) { + $expr = $attr{$name}{'readingsExpr' . $1}; + } + } elsif(($a =~ /reading([0-9]+)Name/) && defined ($attr{$name}{"reading${1}Name"}) + && defined ($attr{$name}{"reading${1}Regex"})) { + # new syntax + $reading = $attr{$name}{"reading${1}Name"}; + $regex = $attr{$name}{"reading${1}Regex"}; + $expr = ""; + if (defined ($attr{$name}{"reading${1}Expr"})) { + $expr = $attr{$name}{"reading${1}Expr"}; + } + } else { + Log3 $name, 3, "$name: inconsistant attributes for $a"; + next; + } + Log3 $name, 5, "$name: Trying to extract Reading $reading with regex /$regex/..."; if ($buffer =~ /$regex/) { my $val = $1; if ($expr) { $val = eval $expr; - Log3 $name, 5, "HTTPMOD: change value for Reading $reading with Expr $expr from $1 to $val"; + Log3 $name, 5, "$name: change value for Reading $reading with Expr $expr from $1 to $val"; } - Log3 $name, 5, "HTTPMOD: Set Reading $reading to $val"; + Log3 $name, 5, "$name: Set Reading $reading to $val"; readingsBulkUpdate( $hash, $reading, $val ); } else { - if ($msg) { - $msg .= ", $reading"; + if ($unmatched) { + $unmatched .= ", $reading"; } else { - $msg = "$reading"; + $unmatched = "$reading"; } } + } + readingsEndUpdate( $hash, 1 ); + if ($unmatched) { + Log3 $name, 3, "$name: Response didn't match Reading(s) $unmatched"; + Log3 $name, 4, "$name: response was $buffer"; + } + return undef; + } +} + + + +####################################### +# Aufruf aus InternalTimer mit "queue:$name" +# oder direkt mit $direct:$name +#todo: sobald letzter Request beantwortet ist (in Read) auch aufrufen. +sub +HTTPMOD_HandleSendQueue($) +{ + my (undef,$name) = split(':', $_[0]); + my $hash = $defs{$name}; + my $queue = $hash->{QUEUE}; + + my $qlen = ($hash->{QUEUE} ? scalar(@{$hash->{QUEUE}}) : 0); + Log3 $name, 5, "$name: handle send queue called, qlen = $qlen"; + RemoveInternalTimer ("queue:$name"); + + if(defined($queue) && @{$queue} > 0) { + + my $queueDelay = AttrVal($name, "queueDelay", 1); + my $now = gettimeofday(); + + if (!$init_done) { # fhem not initialized, wait with IO + InternalTimer($now+$queueDelay, "HTTPMOD_HandleSendQueue", "queue:$name", 0); + Log3 $name, 3, "$name: init not done, delay sending from queue"; + return; + } + if ($hash->{BUSY}) { # still waiting for reply to last request + InternalTimer($now+$queueDelay, "HTTPMOD_HandleSendQueue", "queue:$name", 0); + Log3 $name, 5, "$name: still waiting for reply to last request, delay sending from queue"; + return; + } + + $hash->{REQUEST} = $queue->[0]; + + if($hash->{REQUEST}{url} ne "") { # if something to send - check min delay and send + my $minSendDelay = AttrVal($hash->{NAME}, "minSendDelay", 0.2); + + if ($hash->{LASTSEND} && $now < $hash->{LASTSEND} + $minSendDelay) { + InternalTimer($now+$queueDelay, "HTTPMOD_HandleSendQueue", "queue:$name", 0); + Log3 $name, 5, "$name: HandleSendQueue minSendDelay not over, rescheduling"; + return; + } + + $hash->{BUSY} = 1; # HTTPMOD queue is busy until response is received + $hash->{LASTSEND} = $now; # remember when last sent + $hash->{redirects} = 0; + $hash->{callback} = \&HTTPMOD_Read; + $hash->{url} = $hash->{REQUEST}{url}; + $hash->{header} = $hash->{REQUEST}{header}; + $hash->{data} = $hash->{REQUEST}{data}; + $hash->{timeout} = AttrVal($name, "timeout", 2); + $hash->{ignoreredirects} = $hash->{REQUEST}{ignoreredirects}; + + if (AttrVal($name, "noShutdown", undef)) { + $hash->{noshutdown} = 1; } else { - Log3 $name, 3, "HTTPMOD: inconsitant attributes for $a"; + delete $hash->{noshutdown}; + }; + + if ($hash->{sid}) { + $hash->{header} =~ s/\$sid/$hash->{sid}/g; + $hash->{data} =~ s/\$sid/$hash->{sid}/g; + $hash->{url} =~ s/\$sid/$hash->{sid}/g; + } + + Log3 $name, 4, "$name: HandleSendQueue sends request type $hash->{REQUEST}{type} to " . + "URL $hash->{url}, data $hash->{data}, header $hash->{header}, timeout $hash->{timeout}"; + HttpUtils_NonblockingGet($hash); + } + shift(@{$queue}); # remove first element from queue + if(@{$queue} > 0) { # more items in queue -> schedule next handle + InternalTimer($now+$queueDelay, "HTTPMOD_HandleSendQueue", "queue:$name", 0); + } + } +} + + + +##################################### +sub +HTTPMOD_AddToQueue($$$$$;$$$){ + my ($hash, $url, $header, $data, $type, $count, $ignoreredirects, $prio) = @_; + my $name = $hash->{NAME}; + + $count = 0 if (!$count); + $ignoreredirects = 0 if (!$ignoreredirects); + + my %request; + $request{url} = $url; + $request{header} = $header; + $request{data} = $data; + $request{type} = $type; + $request{retryCount} = $count; + $request{ignoreredirects} = $ignoreredirects; + + my $qlen = ($hash->{QUEUE} ? scalar(@{$hash->{QUEUE}}) : 0); + Log3 $name, 5, "$name: AddToQueue called, initial send queue length : $qlen"; + Log3 $name, 5, "$name: AddToQueue adds type $request{type} to " . + "URL $request{url}, data $request{data}, header $request{header}"; + if(!$qlen) { + $hash->{QUEUE} = [ \%request ]; + } else { + if ($qlen > AttrVal($name, "queueMax", 20)) { + Log3 $name, 3, "$name: send queue too long, dropping request"; + } else { + if ($prio) { + unshift (@{$hash->{QUEUE}}, \%request); # an den Anfang + } else { + push(@{$hash->{QUEUE}}, \%request); # ans Ende + } } } - readingsEndUpdate( $hash, 1 ); - if ($msg) { - Log3 $name, 3, "HTTPMOD: Response didn't match Reading(s) $msg"; - Log3 $name, 4, "HTTPMOD: response was $buffer"; - } - return; - + HTTPMOD_HandleSendQueue("direct:".$name); } 1; - =pod =begin html @@ -334,7 +679,8 @@ sub HTTPMOD_Read($$$)