| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375 |
- ##############################################
- # $Id: 00_FBAHAHTTP.pm 17700 2018-11-07 11:35:48Z rudolfkoenig $
- package main;
- # Documentation: AHA-HTTP-Interface.pdf, AVM_Technical_Note_-_Session_ID.pdf
- use strict;
- use warnings;
- use Time::HiRes qw(gettimeofday);
- use FritzBoxUtils;
- sub
- FBAHAHTTP_Initialize($)
- {
- my ($hash) = @_;
- $hash->{WriteFn} = "FBAHAHTTP_Write";
- $hash->{DefFn} = "FBAHAHTTP_Define";
- $hash->{SetFn} = "FBAHAHTTP_Set";
- $hash->{AttrFn} = "FBAHAHTTP_Attr";
- $hash->{ReadyFn} = "FBAHAHTTP_Ready";
- $hash->{RenameFn} = "FBAHAHTTP_RenameFn";
- $hash->{DeleteFn} = "FBAHAHTTP_Delete";
- $hash->{AttrList} = "dummy:1,0 fritzbox-user polltime async_delay ".
- "disable:0,1 disabledForIntervals fbTimeout";
- }
- #####################################
- sub
- FBAHAHTTP_Define($$)
- {
- my ($hash, $def) = @_;
- my @a = split("[ \t][ \t]*", $def);
- return "wrong syntax: define <name> FBAHAHTTP hostname"
- if(@a != 3);
- $hash->{Clients} = ":FBDECT:";
- my %matchList = ( "1:FBDECT" => ".*" );
- $hash->{MatchList} = \%matchList;
- # Moving definition from FBAHA to FBAHAHTTP
- for my $d (devspec2array("TYPE=FBDECT")) {
- if($defs{$d}{IODev} && $defs{$d}{IODev}{TYPE} eq "FBAHA") {
- my $n = $defs{$d}{IODev}{NAME};
- CommandAttr(undef, "$d IODev $hash->{NAME}");
- CommandDelete(undef, $n) if($defs{$n});
- $defs{$d}{IODev} = $hash;
- my $oldNr = $defs{$d}{IODev}{NR}; # Forum #92286
- $hash->{NR} = $oldNr if($hash->{NR} > $oldNr);
- }
- }
- $hash->{CmdStack} = ();
- return undef if($hash->{DEF} eq "none"); # DEBUGGING
- InternalTimer(1, "FBAHAHTTP_Poll", $hash);
- $hash->{STATE} = "defined";
- return undef;
- }
- #####################################
- sub
- FBAHAHTTP_Delete($)
- {
- my ($hash) = @_;
- my $name = $hash->{NAME};
- my ($err, $fb_pw) = setKeyValue("FBAHAHTTP_PASSWORD_$name", undef);
- return $err;
- }
- sub
- FBAHAHTTP_connect($)
- {
- my ($hash) = @_;
- my $name = $hash->{NAME};
- my $dev = $hash->{DEF};
- my $dr = sub {
- $hash->{STATE} = $_[0];
- Log 2, $hash->{STATE};
- $hash->{CmdStack} = ();
- return $hash->{STATE};
- };
- my $fb_user = AttrVal($name, "fritzbox-user", '');
- return $dr->("MISSING: attr $name fritzbox-user") if(!$fb_user);
- my ($err, $fb_pw) = getKeyValue("FBAHAHTTP_PASSWORD_$name");
- return $dr->("ERROR: $err") if($err);
- return $dr->("MISSING: set $name password") if(!$fb_pw);
- my $sid = FB_doCheckPW($hash->{DEF}, $fb_user, $fb_pw);
- if(!$sid) {
- $hash->{NEXT_OPEN} = time()+60;
- $readyfnlist{"$name.$dev"} = $hash;
- return $dr->("$name error: cannot get SID, ".
- "check connection/hostname/fritzbox-user/password")
- }
- delete($hash->{RetriedCmd});
- delete($readyfnlist{"$name.$dev"});
- $hash->{".SID"} = $sid;
- $hash->{STATE} = "connected";
- Log3 $name, 4, "FBAHAHTTP_connect $name: got SID $sid";
- return undef;
- }
- sub
- FBAHAHTTP_RenameFn($$)
- {
- my ($new, $old) = @_;
- for my $d (devspec2array("TYPE=FBDECT")) {
- my $hash = $defs{$d};
- next if(!$hash);
- $hash->{DEF} =~ s/^$old:/$new:/;
- $attr{$d}{IODev} = $new if(AttrVal($d,"IODev","") eq $old);
- }
- FBDECT_renameIoDev($new, $old);
- }
- #####################################
- sub
- FBAHAHTTP_Poll($)
- {
- my ($hash) = @_;
- my $name = $hash->{NAME};
- return if(IsDisabled($name));
- if(!$hash->{".SID"}) {
- my $ret = FBAHAHTTP_connect($hash);
- return $ret if($ret);
- }
- my $sid = $hash->{".SID"};
- my $host = ($hash->{DEF} =~ m/^http/i ? $hash->{DEF} : "http://$hash->{DEF}");
- HttpUtils_NonblockingGet({
- url=>"$host/webservices/homeautoswitch.lua?sid=$sid".
- "&switchcmd=getdevicelistinfos",
- loglevel => AttrVal($name, "verbose", 4),
- timeout => AttrVal($name, "fbTimeout", 4),
- callback => sub {
- if($_[1]) {
- Log3 $name, 3, "$name: $_[1]";
- delete $hash->{".SID"};
- return;
- }
- Log 5, $_[2] if(AttrVal($name, "verbose", 1) >= 5);
- if($_[2] !~ m,^<devicelist.*</devicelist>$,s) {
- Log3 $name, 3, "$name: unexpected reply from device: $_[2]";
- delete $hash->{".SID"};
- return;
- }
- $_[2] =~ s+<(device|group) (.*?)</\g1>+
- Dispatch($hash, "<$1 $2</$1>", undef);""+gse; # Quick&Hack
- }
- });
- my $polltime = AttrVal($name, "polltime", 300);
- RemoveInternalTimer($hash);
- InternalTimer(gettimeofday()+$polltime, "FBAHAHTTP_Poll", $hash);
- return;
- }
- #####################################
- sub
- FBAHAHTTP_Ready($)
- {
- my ($hash) = @_;
- return if($hash->{NEXT_OPEN} && time() < $hash->{NEXT_OPEN});
- FBAHAHTTP_Poll($hash);
- }
- #####################################
- sub
- FBAHAHTTP_Attr($@)
- {
- my ($type, $devName, $attrName, @param) = @_;
- my $hash = $defs{$devName};
- if($attrName eq "fritzbox-user") {
- return "Cannot delete fritzbox-user" if($type eq "del");
- if($init_done) {
- delete($hash->{".SID"});
- InternalTimer(1, sub { FBAHAHTTP_Poll($hash); }, 0);
- }
- }
- return undef;
- }
- #####################################
- sub
- FBAHAHTTP_Set($@)
- {
- my ($hash, @a) = @_;
- my $name = shift @a;
- my %sets = (password=>2, refreshstate=>1);
- return "set $name needs at least one parameter" if(@a < 1);
- my $type = shift @a;
- return "Unknown argument $type, choose one of refreshstate:noArg password"
- if(!defined($sets{$type}));
- return "Missing argument for $type" if(int(@a) < $sets{$type}-1);
- if($type eq "password") {
- setKeyValue("FBAHAHTTP_PASSWORD_$name", $a[0]);
- delete($hash->{".SID"});
- FBAHAHTTP_Poll($hash);
- return;
- }
- if($type eq "refreshstate") {
- FBAHAHTTP_Poll($hash);
- return;
- }
- return undef;
- }
- sub
- FBAHAHTTP_ProcessStack($)
- {
- my ($hash) = @_;
- my $name = $hash->{NAME};
- my $msg = $hash->{CmdStack}->[0];
- my $host = ($hash->{DEF} =~ m/^http/i ? $hash->{DEF} : "http://$hash->{DEF}");
- my $sid = $hash->{".SID"};
- return if(!$sid);
- HttpUtils_NonblockingGet({
- url=>"$host/webservices/homeautoswitch.lua?sid=$sid&$msg",
- loglevel => AttrVal($name, "verbose", 4),
- timeout => AttrVal($name, "fbTimeout", 4),
- callback => sub {
- if($_[1]) {
- Log3 $name, 3, "$name: $_[1]";
- delete $hash->{".SID"};
- $hash->{CmdStack} = ();
- return;
- }
-
- Log3 $name, 5, "FBAHAHTTP_Write reply for $name: $_[2]";
- if(!defined($_[2]) || $_[2] eq "") {
- if($hash->{RetriedCmd}) {
- Log3 $name, 1, "No sensible respone after reconnect, giving up";
- $hash->{CmdStack} = ();
- return;
- }
- return if(FBAHAHTTP_connect($hash));
- $hash->{RetriedCmd} = $msg;
- FBAHAHTTP_ProcessStack($hash);
- return;
- }
- delete($hash->{RetriedCmd});
- shift @{$hash->{CmdStack}};
- if(@{$hash->{CmdStack}} > 0) {
- my $ad = AttrVal($name, "async_delay", 0);
- InternalTimer(gettimeofday()+$ad, sub(){
- FBAHAHTTP_ProcessStack($hash);
- }, $hash);
- }
- }
- });
- }
- #####################################
- sub
- FBAHAHTTP_Write($$$)
- {
- my ($hash,$fn,$msg) = @_;
- my $name = $hash->{NAME};
- return if(IsDisabled($name));
- my $sid = $hash->{".SID"};
- if(!$sid) {
- my $ret = FBAHAHTTP_connect($hash); # try to reconnect
- return $ret if($ret);
- $sid = $hash->{".SID"};
- }
- push(@{$hash->{CmdStack}}, "ain=$fn&switchcmd=$msg");
- FBAHAHTTP_ProcessStack($hash) if(@{$hash->{CmdStack}} == 1);
- }
- 1;
- =pod
- =item summary connection to the Fritz!OS AHA Server via HTTP
- =item summary_DE Anbindung des Fritz!OS AHA Servers über HTTP
- =begin html
- <a name="FBAHAHTTP"></a>
- <h3>FBAHAHTTP</h3>
- <ul>
- This module connects to the AHA server (AVM Home Automation) on a FRITZ!Box
- via HTTP, it is a successor/drop-in replacement for the FBAHA module. It is
- necessary, as the FBAHA interface is deprecated by AVM. Since the AHA HTTP
- interface do not offer any notification mechanism, the module is regularly
- polling the FRITZ!Box.<br>
- Important: For an existing installation with an FBAHA device, defining a
- new FBAHAHTTP device will change the IODev of all FBDECT devices from the
- old FBAHA to this FBAHAHTTP device, and it will delete the FBAHA device.<br>
- This module serves as the "physical" counterpart to the <a
- href="#FBDECT">FBDECT</a> devices. Note: you have to enable the access to
- Smart Home in the FRITZ!Box frontend for the fritzbox-user, and take care
- to configure the login in the home network with username AND password.
- <br><br>
- <a name="FBAHAHTTPdefine"></a>
- <b>Define</b>
- <ul>
- <code>define <name> FBAHAHTTP <hostname></code><br>
- <br>
- <hostnamedevice> is most probably fritz.box.
- Example:
- <ul>
- <code>define fb1 FBAHAHTTP fritz.box</code><br>
- </ul>
- Note: to specify HTTPS for the connection use https://fritz.box as
- hostname. To explicitly specify the port, postfix the hostname with :port,
- as in https://fritz.box:443
- </ul>
- <br>
- <a name="FBAHAHTTPset"></a>
- <b>Set</b>
- <ul>
- <li>password <password><br>
- This is the only way to set the password
- </li>
- <li>refreshstate<br>
- The state of all devices is polled every <polltime> seconds (default
- is 300). This command forces a state-refresh.
- </li>
- </ul>
- <br>
- <a name="FBAHAHTTPget"></a>
- <b>Get</b>
- <ul>N/A</ul>
- <br>
- <a name="FBAHAHTTPattr"></a>
- <b>Attributes</b>
- <ul>
- <li><a href="#async_delay">async_delay</a><br>
- additional delay inserted, when switching more than one device, default
- is 0.2 seconds. Note: even with async_delay 0 there will be a delay, as
- FHEM avoids sending commands in parallel, to avoid malfunctioning of the
- Fritz!BOX AHA server).
- </li>
- <li><a href="#disable">disable</a></li>
- <li><a href="#disabledForIntervals">disabledForIntervals</a></li>
- <li><a href="#dummy">dummy</a></li>
- <li><a href="#fritzbox-user">fritzbox-user</a></li>
- <li><a name="polltime">polltime</a><br>
- measured in seconds, default is 300 i.e. 5 minutes
- </li>
- <li><a name="fbTimeout">fbTimeout</a><br>
- timeout for getting answer from the Fritz!BOX. Default is 4 (seconds).
- </li>
- </ul>
- <br>
- </ul>
- =end html
- =cut
|