mirror of
https://github.com/fhem/fhem-mirror.git
synced 2025-01-31 06:39:11 +00:00
473 lines
13 KiB
Perl
473 lines
13 KiB
Perl
##############################################
|
|
# $Id$
|
|
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->{GetFn} = "FBAHAHTTP_Get";
|
|
$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_err($$)
|
|
{
|
|
my ($hash, $err) = @_;
|
|
$hash->{STATE} = $err;
|
|
Log 2, "$hash->{NAME} $err";
|
|
$hash->{CmdStack} = ();
|
|
return $err;
|
|
}
|
|
|
|
sub
|
|
FBAHAHTTP_connect($$)
|
|
{
|
|
my ($hash, $doProcess) = @_;
|
|
my $name = $hash->{NAME};
|
|
my $dev = $hash->{DEF};
|
|
|
|
|
|
my $fb_user = AttrVal($name, "fritzbox-user", '');
|
|
return FBAHAHTTP_err($hash, "MISSING attr $name fritzbox-user") if(!$fb_user);
|
|
|
|
my ($err, $fb_pw) = getKeyValue("FBAHAHTTP_PASSWORD_$name");
|
|
return FBAHAHTTP_err($hash, "ERROR: $err") if($err);
|
|
return FBAHAHTTP_err($hash, "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 FBAHAHTTP_err($hash, "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";
|
|
FBAHAHTTP_ProcessStack($hash)
|
|
if($doProcess && $hash->{CmdStack} && int(@{$hash->{CmdStack}}));
|
|
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, 0);
|
|
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,template=>2);
|
|
|
|
return "set $name needs at least one parameter" if(@a < 1);
|
|
my $type = shift @a;
|
|
|
|
my $tl = ReadingsVal($name,"templateList","");
|
|
my $cmdList = "refreshstate:noArg password".($tl ? " template:$tl" : "");
|
|
return "Unknown argument $type, choose one of $cmdList"
|
|
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);
|
|
|
|
} elsif($type eq "refreshstate") {
|
|
FBAHAHTTP_Poll($hash);
|
|
|
|
} elsif($type eq "template") {
|
|
my $cl = $hash->{CL};
|
|
my $doRet = sub($)
|
|
{
|
|
if($cl) {
|
|
asyncOutput($cl, $_[0]);
|
|
} else {
|
|
Log3 $hash, 4, "$_";
|
|
}
|
|
};
|
|
FBAHAHTTP_GetTemplateList($hash, sub($$){
|
|
my ($err, $r) = @_;
|
|
return $doRet->($err) if($err);
|
|
return $doRet->("Unknown template $a[0]") if(!defined($r->{$a[0]}));
|
|
FBAHAHTTP_Write($hash, $r->{$a[0]}, "applytemplate");
|
|
});
|
|
}
|
|
|
|
return undef;
|
|
}
|
|
|
|
sub
|
|
FBAHAHTTP_GetTemplateList($$)
|
|
{
|
|
my ($hash, $callbackFn) = @_;
|
|
|
|
my $host = ($hash->{DEF} =~ m/^http/i ? $hash->{DEF}:"http://$hash->{DEF}");
|
|
my $sid = $hash->{".SID"};
|
|
my $name = $hash->{NAME};
|
|
return "No SID found" if(!$sid);
|
|
HttpUtils_NonblockingGet({
|
|
url=>"$host/webservices/homeautoswitch.lua?".
|
|
"sid=$sid&switchcmd=gettemplatelistinfos",
|
|
loglevel => AttrVal($name, "verbose", 4),
|
|
timeout => AttrVal($name, "fbTimeout", 4),
|
|
callback => sub {
|
|
if($_[1]) {
|
|
delete $hash->{".SID"};
|
|
return $callbackFn->("$name: $_[1]");
|
|
}
|
|
my $ret = (defined($_[2]) ? $_[2] : "") ;
|
|
my %r;
|
|
$ret =~ s:<template identifier="([^"]*)".*?<name>([^<]+)</name>:
|
|
$r{$2}=$1:ge;
|
|
$callbackFn->(undef, \%r);
|
|
}
|
|
});
|
|
}
|
|
|
|
#####################################
|
|
sub
|
|
FBAHAHTTP_Get($@)
|
|
{
|
|
my ($hash, @a) = @_;
|
|
my $name = shift @a;
|
|
my %gets = (templatelist=>1);
|
|
return "get $name needs at least one parameter" if(@a < 1);
|
|
my $type = shift @a;
|
|
my $cl = $hash->{CL};
|
|
|
|
return "Unknown argument $type, choose one of templatelist:noArg"
|
|
if(!defined($gets{$type}));
|
|
return "Missing argument for $type" if(int(@a) < $gets{$type}-1);
|
|
|
|
if($type eq "templatelist") {
|
|
my $doRet = sub($)
|
|
{
|
|
if($cl) {
|
|
asyncOutput($cl, $_[0]);
|
|
} else {
|
|
Log3 $hash, 4, "$_";
|
|
}
|
|
};
|
|
FBAHAHTTP_GetTemplateList($hash, sub($$){
|
|
my ($err, $r) = @_;
|
|
return $doRet->($err) if($err);
|
|
my $str = join(",",sort keys %{$r});
|
|
readingsSingleUpdate($hash, "templateList", $str, 1);
|
|
$doRet->($str);
|
|
});
|
|
}
|
|
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;
|
|
}
|
|
|
|
my $ret = (defined($_[2]) ? $_[2] : "") ;
|
|
$ret =~ s/[\r\n]//g;
|
|
Log3 $name, 5, "FBAHAHTTP_Write reply for $name: $ret";
|
|
if($ret eq "") {
|
|
if($hash->{RetriedCmd}) {
|
|
Log3 $name, 1,
|
|
"$name: No sensible response for $msg after reconnect, giving up";
|
|
$hash->{CmdStack} = ();
|
|
return;
|
|
}
|
|
return if(FBAHAHTTP_connect($hash, 0));
|
|
$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);
|
|
}, {});
|
|
}
|
|
}
|
|
});
|
|
}
|
|
|
|
#####################################
|
|
sub
|
|
FBAHAHTTP_Write($$$)
|
|
{
|
|
my ($hash,$fn,$msg) = @_;
|
|
my $name = $hash->{NAME};
|
|
|
|
return if(IsDisabled($name));
|
|
|
|
if(!$hash->{".SID"}) {
|
|
my $ret = FBAHAHTTP_connect($hash, 1); # try to reconnect
|
|
return $ret if($ret);
|
|
}
|
|
$fn =~ s/ //g;
|
|
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>
|
|
<li>template <templateName><br>
|
|
Set the the template. Note: reported to work for templates without space
|
|
characters (Forum #98913)
|
|
</li>
|
|
</ul>
|
|
<br>
|
|
|
|
<a name="FBAHAHTTPget"></a>
|
|
<b>Get</b>
|
|
<ul>
|
|
<li>templateList<br>
|
|
get the list of templates from the Fritz!Box, and store the in the
|
|
templateList reading. Needed for the set template command.
|
|
</li>
|
|
</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
|